about summary refs log tree commit diff
path: root/third_party/lisp/alexandria
diff options
context:
space:
mode:
authorVincent Ambo <mail@tazj.in>2021-12-15T20·10+0300
committerclbot <clbot@tvl.fyi>2021-12-15T21·02+0000
commit28ac55e94a4c71c1594d7ec51846315aed03e815 (patch)
tree3cedf2ff4a608605163b848c727690a39821ee10 /third_party/lisp/alexandria
parent50b43cfb66a46fb5579e71d0e55174bb77fa2858 (diff)
chore(3p/lisp): Unvendor alexandria and use nixpkgs sources r/3254
Change-Id: Idee3cb18ac42bd820d87aac0c68206436c1f4691
Reviewed-on: https://cl.tvl.fyi/c/depot/+/4338
Autosubmit: tazjin <mail@tazj.in>
Tested-by: BuildkiteCI
Reviewed-by: grfn <grfn@gws.fyi>
Diffstat (limited to 'third_party/lisp/alexandria')
-rw-r--r--third_party/lisp/alexandria/.boring13
-rw-r--r--third_party/lisp/alexandria/.gitignore4
-rw-r--r--third_party/lisp/alexandria/AUTHORS9
-rw-r--r--third_party/lisp/alexandria/LICENCE37
-rw-r--r--third_party/lisp/alexandria/README52
-rw-r--r--third_party/lisp/alexandria/alexandria-tests.asd11
-rw-r--r--third_party/lisp/alexandria/alexandria.asd62
-rw-r--r--third_party/lisp/alexandria/arrays.lisp18
-rw-r--r--third_party/lisp/alexandria/binding.lisp90
-rw-r--r--third_party/lisp/alexandria/conditions.lisp91
-rw-r--r--third_party/lisp/alexandria/control-flow.lisp106
-rw-r--r--third_party/lisp/alexandria/default.nix28
-rw-r--r--third_party/lisp/alexandria/definitions.lisp37
-rw-r--r--third_party/lisp/alexandria/doc/.gitignore3
-rw-r--r--third_party/lisp/alexandria/doc/Makefile28
-rw-r--r--third_party/lisp/alexandria/doc/alexandria.texinfo277
-rw-r--r--third_party/lisp/alexandria/doc/docstrings.lisp881
-rw-r--r--third_party/lisp/alexandria/features.lisp14
-rw-r--r--third_party/lisp/alexandria/functions.lisp161
-rw-r--r--third_party/lisp/alexandria/hash-tables.lisp101
-rw-r--r--third_party/lisp/alexandria/io.lisp172
-rw-r--r--third_party/lisp/alexandria/lists.lisp367
-rw-r--r--third_party/lisp/alexandria/macros.lisp370
-rw-r--r--third_party/lisp/alexandria/numbers.lisp295
-rw-r--r--third_party/lisp/alexandria/package.lisp243
-rw-r--r--third_party/lisp/alexandria/sequences.lisp555
-rw-r--r--third_party/lisp/alexandria/strings.lisp6
-rw-r--r--third_party/lisp/alexandria/symbols.lisp65
-rw-r--r--third_party/lisp/alexandria/tests.lisp2047
-rw-r--r--third_party/lisp/alexandria/types.lisp137
30 files changed, 0 insertions, 6280 deletions
diff --git a/third_party/lisp/alexandria/.boring b/third_party/lisp/alexandria/.boring
deleted file mode 100644
index dfa9e6dd7bb4..000000000000
--- a/third_party/lisp/alexandria/.boring
+++ /dev/null
@@ -1,13 +0,0 @@
-# Boring file regexps:
-~$
-^_darcs
-^\{arch\}
-^.arch-ids
-\#
-\.dfsl$
-\.ppcf$
-\.fasl$
-\.x86f$
-\.fas$
-\.lib$
-^public_html
diff --git a/third_party/lisp/alexandria/.gitignore b/third_party/lisp/alexandria/.gitignore
deleted file mode 100644
index e832e9471833..000000000000
--- a/third_party/lisp/alexandria/.gitignore
+++ /dev/null
@@ -1,4 +0,0 @@
-*.fasl
-*~
-\#*
-*.patch
diff --git a/third_party/lisp/alexandria/AUTHORS b/third_party/lisp/alexandria/AUTHORS
deleted file mode 100644
index b550ea503248..000000000000
--- a/third_party/lisp/alexandria/AUTHORS
+++ /dev/null
@@ -1,9 +0,0 @@
-
-ACTA EST FABULA PLAUDITE
-
-Nikodemus Siivola 
-Attila Lendvai
-Marco Baringer
-Robert Strandh
-Luis Oliveira
-Tobias C. Rittweiler
\ No newline at end of file
diff --git a/third_party/lisp/alexandria/LICENCE b/third_party/lisp/alexandria/LICENCE
deleted file mode 100644
index b5140fbb2491..000000000000
--- a/third_party/lisp/alexandria/LICENCE
+++ /dev/null
@@ -1,37 +0,0 @@
-Alexandria software and associated documentation are in the public
-domain:
-
-  Authors dedicate this work to public domain, for the benefit of the
-  public at large and to the detriment of the authors' heirs and
-  successors. Authors intends this dedication to be an overt act of
-  relinquishment in perpetuity of all present and future rights under
-  copyright law, whether vested or contingent, in the work. Authors
-  understands that such relinquishment of all rights includes the
-  relinquishment of all rights to enforce (by lawsuit or otherwise)
-  those copyrights in the work.
-
-  Authors recognize that, once placed in the public domain, the work
-  may be freely reproduced, distributed, transmitted, used, modified,
-  built upon, or otherwise exploited by anyone for any purpose,
-  commercial or non-commercial, and in any way, including by methods
-  that have not yet been invented or conceived.
-
-In those legislations where public domain dedications are not
-recognized or possible, Alexandria is distributed under the following
-terms and conditions:
-
-  Permission is hereby granted, free of charge, to any person
-  obtaining a copy of this software and associated documentation files
-  (the "Software"), to deal in the Software without restriction,
-  including without limitation the rights to use, copy, modify, merge,
-  publish, distribute, sublicense, and/or sell copies of the Software,
-  and to permit persons to whom the Software is furnished to do so,
-  subject to the following conditions:
-
-  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/third_party/lisp/alexandria/README b/third_party/lisp/alexandria/README
deleted file mode 100644
index a5dae9ed1ac7..000000000000
--- a/third_party/lisp/alexandria/README
+++ /dev/null
@@ -1,52 +0,0 @@
-Alexandria is a collection of portable public domain utilities that
-meet the following constraints:
-
- * Utilities, not extensions: Alexandria will not contain conceptual
-   extensions to Common Lisp, instead limiting itself to tools and
-   utilities that fit well within the framework of standard ANSI
-   Common Lisp. Test-frameworks, system definitions, logging
-   facilities, serialization layers, etc. are all outside the scope of
-   Alexandria as a library, though well within the scope of Alexandria
-   as a project.
-
- * Conservative: Alexandria limits itself to what project members
-   consider conservative utilities. Alexandria does not and will not
-   include anaphoric constructs, loop-like binding macros, etc.
-
- * Portable: Alexandria limits itself to portable parts of Common
-   Lisp. Even apparently conservative and useful functions remain
-   outside the scope of Alexandria if they cannot be implemented
-   portably. Portability is here defined as portable within a
-   conforming implementation: implementation bugs are not considered
-   portability issues.
-
-Homepage:
-
-  http://common-lisp.net/project/alexandria/
-
-Mailing lists:
-
-  http://lists.common-lisp.net/mailman/listinfo/alexandria-devel
-  http://lists.common-lisp.net/mailman/listinfo/alexandria-cvs
-
-Repository:
-
-  git://gitlab.common-lisp.net/alexandria/alexandria.git
-
-Documentation:
-
-  http://common-lisp.net/project/alexandria/draft/alexandria.html
-
-  (To build docs locally: cd doc && make html pdf info)
-
-Patches:
-
-  Patches are always welcome! Please send them to the mailing list as
-  attachments, generated by "git format-patch -1".
-
-  Patches should include a commit message that explains what's being
-  done and /why/, and when fixing a bug or adding a feature you should
-  also include a test-case.
-
-  Be advised though that right now new features are unlikely to be
-  accepted until 1.0 is officially out of the door.
diff --git a/third_party/lisp/alexandria/alexandria-tests.asd b/third_party/lisp/alexandria/alexandria-tests.asd
deleted file mode 100644
index 445c18cf7f77..000000000000
--- a/third_party/lisp/alexandria/alexandria-tests.asd
+++ /dev/null
@@ -1,11 +0,0 @@
-(defsystem "alexandria-tests"
-  :licence "Public Domain / 0-clause MIT"
-  :description "Tests for Alexandria, which is a collection of portable public domain utilities."
-  :author "Nikodemus Siivola <nikodemus@sb-studio.net>, and others."
-  :depends-on (:alexandria #+sbcl :sb-rt #-sbcl :rt)
-  :components ((:file "tests"))
-  :perform (test-op (o c)
-             (flet ((run-tests (&rest args)
-                      (apply (intern (string '#:run-tests) '#:alexandria-tests) args)))
-               (run-tests :compiled nil)
-               (run-tests :compiled t))))
diff --git a/third_party/lisp/alexandria/alexandria.asd b/third_party/lisp/alexandria/alexandria.asd
deleted file mode 100644
index db10e4f53710..000000000000
--- a/third_party/lisp/alexandria/alexandria.asd
+++ /dev/null
@@ -1,62 +0,0 @@
-(defsystem "alexandria"
-  :version "1.0.0"
-  :licence "Public Domain / 0-clause MIT"
-  :description "Alexandria is a collection of portable public domain utilities."
-  :author "Nikodemus Siivola and others."
-  :long-description
-  "Alexandria is a project and a library.
-
-As a project Alexandria's goal is to reduce duplication of effort and improve
-portability of Common Lisp code according to its own idiosyncratic and rather
-conservative aesthetic.
-
-As a library Alexandria is one of the means by which the project strives for
-its goals.
-
-Alexandria is a collection of portable public domain utilities that meet
-the following constraints:
-
- * Utilities, not extensions: Alexandria will not contain conceptual
-   extensions to Common Lisp, instead limiting itself to tools and utilities
-   that fit well within the framework of standard ANSI Common Lisp.
-   Test-frameworks, system definitions, logging facilities, serialization
-   layers, etc. are all outside the scope of Alexandria as a library, though
-   well within the scope of Alexandria as a project.
-
- * Conservative: Alexandria limits itself to what project members consider
-   conservative utilities. Alexandria does not and will not include anaphoric
-   constructs, loop-like binding macros, etc.
-   Also, its exported symbols are being imported by many other packages
-   already, so each new export carries the danger of causing conflicts.
-
- * Portable: Alexandria limits itself to portable parts of Common Lisp. Even
-   apparently conservative and useful functions remain outside the scope of
-   Alexandria if they cannot be implemented portably. Portability is here
-   defined as portable within a conforming implementation: implementation bugs
-   are not considered portability issues.
-
- * Team player: Alexandria will not (initially, at least) subsume or provide
-   functionality for which good-quality special-purpose packages exist, like
-   split-sequence. Instead, third party packages such as that may be
-   \"blessed\"."
-  :components
-  ((:static-file "LICENCE")
-   (:static-file "tests.lisp")
-   (:file "package")
-   (:file "definitions" :depends-on ("package"))
-   (:file "binding" :depends-on ("package"))
-   (:file "strings" :depends-on ("package"))
-   (:file "conditions" :depends-on ("package"))
-   (:file "io" :depends-on ("package" "macros" "lists" "types"))
-   (:file "macros" :depends-on ("package" "strings" "symbols"))
-   (:file "hash-tables" :depends-on ("package" "macros"))
-   (:file "control-flow" :depends-on ("package" "definitions" "macros"))
-   (:file "symbols" :depends-on ("package"))
-   (:file "functions" :depends-on ("package" "symbols" "macros"))
-   (:file "lists" :depends-on ("package" "functions"))
-   (:file "types" :depends-on ("package" "symbols" "lists"))
-   (:file "arrays" :depends-on ("package" "types"))
-   (:file "sequences" :depends-on ("package" "lists" "types"))
-   (:file "numbers" :depends-on ("package" "sequences"))
-   (:file "features" :depends-on ("package" "control-flow")))
-  :in-order-to ((test-op (test-op "alexandria-tests"))))
diff --git a/third_party/lisp/alexandria/arrays.lisp b/third_party/lisp/alexandria/arrays.lisp
deleted file mode 100644
index 76c18791ad5f..000000000000
--- a/third_party/lisp/alexandria/arrays.lisp
+++ /dev/null
@@ -1,18 +0,0 @@
-(in-package :alexandria)
-
-(defun copy-array (array &key (element-type (array-element-type array))
-                              (fill-pointer (and (array-has-fill-pointer-p array)
-                                                 (fill-pointer array)))
-                              (adjustable (adjustable-array-p array)))
-  "Returns an undisplaced copy of ARRAY, with same fill-pointer and
-adjustability (if any) as the original, unless overridden by the keyword
-arguments."
- (let* ((dimensions (array-dimensions array))
-        (new-array (make-array dimensions
-                               :element-type element-type
-                               :adjustable adjustable
-                               :fill-pointer fill-pointer)))
-   (dotimes (i (array-total-size array))
-     (setf (row-major-aref new-array i)
-           (row-major-aref array i)))
-   new-array))
diff --git a/third_party/lisp/alexandria/binding.lisp b/third_party/lisp/alexandria/binding.lisp
deleted file mode 100644
index 37a3d52fb9f0..000000000000
--- a/third_party/lisp/alexandria/binding.lisp
+++ /dev/null
@@ -1,90 +0,0 @@
-(in-package :alexandria)
-
-(defmacro if-let (bindings &body (then-form &optional else-form))
-    "Creates new variable bindings, and conditionally executes either
-THEN-FORM or ELSE-FORM. ELSE-FORM defaults to NIL.
-
-BINDINGS must be either single binding of the form:
-
- (variable initial-form)
-
-or a list of bindings of the form:
-
- ((variable-1 initial-form-1)
-  (variable-2 initial-form-2)
-  ...
-  (variable-n initial-form-n))
-
-All initial-forms are executed sequentially in the specified order. Then all
-the variables are bound to the corresponding values.
-
-If all variables were bound to true values, the THEN-FORM is executed with the
-bindings in effect, otherwise the ELSE-FORM is executed with the bindings in
-effect."
-    (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
-                             (list bindings)
-                             bindings))
-         (variables (mapcar #'car binding-list)))
-    `(let ,binding-list
-       (if (and ,@variables)
-           ,then-form
-           ,else-form))))
-
-(defmacro when-let (bindings &body forms)
-    "Creates new variable bindings, and conditionally executes FORMS.
-
-BINDINGS must be either single binding of the form:
-
- (variable initial-form)
-
-or a list of bindings of the form:
-
- ((variable-1 initial-form-1)
-  (variable-2 initial-form-2)
-  ...
-  (variable-n initial-form-n))
-
-All initial-forms are executed sequentially in the specified order. Then all
-the variables are bound to the corresponding values.
-
-If all variables were bound to true values, then FORMS are executed as an
-implicit PROGN."
-  (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
-                           (list bindings)
-                           bindings))
-         (variables (mapcar #'car binding-list)))
-    `(let ,binding-list
-       (when (and ,@variables)
-         ,@forms))))
-
-(defmacro when-let* (bindings &body body)
-  "Creates new variable bindings, and conditionally executes BODY.
-
-BINDINGS must be either single binding of the form:
-
- (variable initial-form)
-
-or a list of bindings of the form:
-
- ((variable-1 initial-form-1)
-  (variable-2 initial-form-2)
-  ...
-  (variable-n initial-form-n))
-
-Each INITIAL-FORM is executed in turn, and the variable bound to the
-corresponding value. INITIAL-FORM expressions can refer to variables
-previously bound by the WHEN-LET*.
-
-Execution of WHEN-LET* stops immediately if any INITIAL-FORM evaluates to NIL.
-If all INITIAL-FORMs evaluate to true, then BODY is executed as an implicit
-PROGN."
-  (let ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
-                          (list bindings)
-                          bindings)))
-    (labels ((bind (bindings body)
-               (if bindings
-                   `(let (,(car bindings))
-                      (when ,(caar bindings)
-                        ,(bind (cdr bindings) body)))
-                   `(progn ,@body))))
-      (bind binding-list body))))
diff --git a/third_party/lisp/alexandria/conditions.lisp b/third_party/lisp/alexandria/conditions.lisp
deleted file mode 100644
index ac471cca7e4c..000000000000
--- a/third_party/lisp/alexandria/conditions.lisp
+++ /dev/null
@@ -1,91 +0,0 @@
-(in-package :alexandria)
-
-(defun required-argument (&optional name)
-  "Signals an error for a missing argument of NAME. Intended for
-use as an initialization form for structure and class-slots, and
-a default value for required keyword arguments."
-  (error "Required argument ~@[~S ~]missing." name))
-
-(define-condition simple-style-warning (simple-warning style-warning)
-  ())
-
-(defun simple-style-warning (message &rest args)
-  (warn 'simple-style-warning :format-control message :format-arguments args))
-
-;; We don't specify a :report for simple-reader-error to let the
-;; underlying implementation report the line and column position for
-;; us. Unfortunately this way the message from simple-error is not
-;; displayed, unless there's special support for that in the
-;; implementation. But even then it's still inspectable from the
-;; debugger...
-(define-condition simple-reader-error
-    #-sbcl(simple-error reader-error)
-    #+sbcl(sb-int:simple-reader-error)
-  ())
-
-(defun simple-reader-error (stream message &rest args)
-  (error 'simple-reader-error
-         :stream stream
-         :format-control message
-         :format-arguments args))
-
-(define-condition simple-parse-error (simple-error parse-error)
-  ())
-
-(defun simple-parse-error (message &rest args)
-  (error 'simple-parse-error
-         :format-control message
-         :format-arguments args))
-
-(define-condition simple-program-error (simple-error program-error)
-  ())
-
-(defun simple-program-error (message &rest args)
-  (error 'simple-program-error
-         :format-control message
-         :format-arguments args))
-
-(defmacro ignore-some-conditions ((&rest conditions) &body body)
-  "Similar to CL:IGNORE-ERRORS but the (unevaluated) CONDITIONS
-list determines which specific conditions are to be ignored."
-  `(handler-case
-       (progn ,@body)
-     ,@(loop for condition in conditions collect
-             `(,condition (c) (values nil c)))))
-
-(defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
-  "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
-the cleanup CLAUSES are run.
-
-  clauses ::= (:NORMAL form*)* | (:ABORT form*)* | (:ALWAYS form*)*
-
-Clauses can be given in any order, and more than one clause can be
-given for each circumstance. The clauses whose denoted circumstance
-occured, are executed in the order the clauses appear.
-
-ABORT-FLAG is the name of a variable that will be bound to T in
-CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
-otherwise.
-
-Examples:
-
-  (unwind-protect-case ()
-       (protected-form)
-     (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
-     (:abort  (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
-     (:always (format t \"This is evaluated in either case.~%\")))
-
-  (unwind-protect-case (aborted-p)
-       (protected-form)
-     (:always (perform-cleanup-if aborted-p)))
-"
-  (check-type abort-flag (or null symbol))
-  (let ((gflag (gensym "FLAG+")))
-    `(let ((,gflag t))
-       (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
-	 (let ,(and abort-flag `((,abort-flag ,gflag)))
-	   ,@(loop for (cleanup-kind . forms) in clauses
-		   collect (ecase cleanup-kind
-			     (:normal `(when (not ,gflag) ,@forms))
-			     (:abort  `(when ,gflag ,@forms))
-			     (:always `(progn ,@forms)))))))))
\ No newline at end of file
diff --git a/third_party/lisp/alexandria/control-flow.lisp b/third_party/lisp/alexandria/control-flow.lisp
deleted file mode 100644
index dd00df3e1620..000000000000
--- a/third_party/lisp/alexandria/control-flow.lisp
+++ /dev/null
@@ -1,106 +0,0 @@
-(in-package :alexandria)
-
-(defun extract-function-name (spec)
-  "Useful for macros that want to mimic the functional interface for functions
-like #'eq and 'eq."
-  (if (and (consp spec)
-           (member (first spec) '(quote function)))
-      (second spec)
-      spec))
-
-(defun generate-switch-body (whole object clauses test key &optional default)
-  (with-gensyms (value)
-    (setf test (extract-function-name test))
-    (setf key (extract-function-name key))
-    (when (and (consp default)
-               (member (first default) '(error cerror)))
-      (setf default `(,@default "No keys match in SWITCH. Testing against ~S with ~S."
-                      ,value ',test)))
-    `(let ((,value (,key ,object)))
-      (cond ,@(mapcar (lambda (clause)
-                        (if (member (first clause) '(t otherwise))
-                            (progn
-                              (when default
-                                (error "Multiple default clauses or illegal use of a default clause in ~S."
-                                       whole))
-                              (setf default `(progn ,@(rest clause)))
-                              '(()))
-                            (destructuring-bind (key-form &body forms) clause
-                              `((,test ,value ,key-form)
-                                ,@forms))))
-                      clauses)
-            (t ,default)))))
-
-(defmacro switch (&whole whole (object &key (test 'eql) (key 'identity))
-                         &body clauses)
-  "Evaluates first matching clause, returning its values, or evaluates and
-returns the values of T or OTHERWISE if no keys match."
-  (generate-switch-body whole object clauses test key))
-
-(defmacro eswitch (&whole whole (object &key (test 'eql) (key 'identity))
-                          &body clauses)
-  "Like SWITCH, but signals an error if no key matches."
-  (generate-switch-body whole object clauses test key '(error)))
-
-(defmacro cswitch (&whole whole (object &key (test 'eql) (key 'identity))
-                          &body clauses)
-  "Like SWITCH, but signals a continuable error if no key matches."
-  (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH.")))
-
-(defmacro whichever (&rest possibilities &environment env)
-  "Evaluates exactly one of POSSIBILITIES, chosen at random."
-  (setf possibilities (mapcar (lambda (p) (macroexpand p env)) possibilities))
-  (if (every (lambda (p) (constantp p)) possibilities)
-      `(svref (load-time-value (vector ,@possibilities)) (random ,(length possibilities)))
-      (labels ((expand (possibilities position random-number)
-                 (if (null (cdr possibilities))
-                     (car possibilities)
-                     (let* ((length (length possibilities))
-                            (half (truncate length 2))
-                            (second-half (nthcdr half possibilities))
-                            (first-half (butlast possibilities (- length half))))
-                       `(if (< ,random-number ,(+ position half))
-                            ,(expand first-half position random-number)
-                            ,(expand second-half (+ position half) random-number))))))
-        (with-gensyms (random-number)
-          (let ((length (length possibilities)))
-            `(let ((,random-number (random ,length)))
-               ,(expand possibilities 0 random-number)))))))
-
-(defmacro xor (&rest datums)
-  "Evaluates its arguments one at a time, from left to right. If more than one
-argument evaluates to a true value no further DATUMS are evaluated, and NIL is
-returned as both primary and secondary value. If exactly one argument
-evaluates to true, its value is returned as the primary value after all the
-arguments have been evaluated, and T is returned as the secondary value. If no
-arguments evaluate to true NIL is retuned as primary, and T as secondary
-value."
-  (with-gensyms (xor tmp true)
-    `(let (,tmp ,true)
-       (block ,xor
-         ,@(mapcar (lambda (datum)
-                     `(if (setf ,tmp ,datum)
-                          (if ,true
-                              (return-from ,xor (values nil nil))
-                              (setf ,true ,tmp))))
-                   datums)
-         (return-from ,xor (values ,true t))))))
-
-(defmacro nth-value-or (nth-value &body forms)
-  "Evaluates FORM arguments one at a time, until the NTH-VALUE returned by one
-of the forms is true. It then returns all the values returned by evaluating
-that form. If none of the forms return a true nth value, this form returns
-NIL."
-  (once-only (nth-value)
-    (with-gensyms (values)
-      `(let ((,values (multiple-value-list ,(first forms))))
-         (if (nth ,nth-value ,values)
-             (values-list ,values)
-             ,(if (rest forms)
-                  `(nth-value-or ,nth-value ,@(rest forms))
-                  nil))))))
-
-(defmacro multiple-value-prog2 (first-form second-form &body forms)
-  "Evaluates FIRST-FORM, then SECOND-FORM, and then FORMS. Yields as its value
-all the value returned by SECOND-FORM."
-  `(progn ,first-form (multiple-value-prog1 ,second-form ,@forms)))
diff --git a/third_party/lisp/alexandria/default.nix b/third_party/lisp/alexandria/default.nix
deleted file mode 100644
index 2358c898b3ab..000000000000
--- a/third_party/lisp/alexandria/default.nix
+++ /dev/null
@@ -1,28 +0,0 @@
-# Alexandria is one of the foundational Common Lisp libraries that
-# pretty much everything depends on:
-#
-# Imported from https://common-lisp.net/project/alexandria/
-{ depot, ... }:
-
-depot.nix.buildLisp.library {
-  name = "alexandria";
-  srcs = [
-    ./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/alexandria/definitions.lisp b/third_party/lisp/alexandria/definitions.lisp
deleted file mode 100644
index 863e1f696286..000000000000
--- a/third_party/lisp/alexandria/definitions.lisp
+++ /dev/null
@@ -1,37 +0,0 @@
-(in-package :alexandria)
-
-(defun %reevaluate-constant (name value test)
-  (if (not (boundp name))
-      value
-      (let ((old (symbol-value name))
-            (new value))
-        (if (not (constantp name))
-            (prog1 new
-              (cerror "Try to redefine the variable as a constant."
-                      "~@<~S is an already bound non-constant variable ~
-                       whose value is ~S.~:@>" name old))
-            (if (funcall test old new)
-                old
-                (restart-case
-                    (error "~@<~S is an already defined constant whose value ~
-                              ~S is not equal to the provided initial value ~S ~
-                              under ~S.~:@>" name old new test)
-                  (ignore ()
-                    :report "Retain the current value."
-                    old)
-                  (continue ()
-                    :report "Try to redefine the constant."
-                    new)))))))
-
-(defmacro define-constant (name initial-value &key (test ''eql) documentation)
-  "Ensures that the global variable named by NAME is a constant with a value
-that is equal under TEST to the result of evaluating INITIAL-VALUE. TEST is a
-/function designator/ that defaults to EQL. If DOCUMENTATION is given, it
-becomes the documentation string of the constant.
-
-Signals an error if NAME is already a bound non-constant variable.
-
-Signals an error if NAME is already a constant variable whose value is not
-equal under TEST to result of evaluating INITIAL-VALUE."
-  `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
-     ,@(when documentation `(,documentation))))
diff --git a/third_party/lisp/alexandria/doc/.gitignore b/third_party/lisp/alexandria/doc/.gitignore
deleted file mode 100644
index f22577b3ac86..000000000000
--- a/third_party/lisp/alexandria/doc/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-alexandria
-include
-
diff --git a/third_party/lisp/alexandria/doc/Makefile b/third_party/lisp/alexandria/doc/Makefile
deleted file mode 100644
index 85eb818220d5..000000000000
--- a/third_party/lisp/alexandria/doc/Makefile
+++ /dev/null
@@ -1,28 +0,0 @@
-.PHONY: clean html pdf include clean-include clean-crap info doc
-
-doc: pdf html info clean-crap
-
-clean-include:
-	rm -rf include
-
-clean-crap:
-	rm -f *.aux *.cp *.fn *.fns *.ky *.log *.pg *.toc *.tp *.tps *.vr
-
-clean: clean-include
-	rm -f  *.pdf *.html *.info
-
-include:
-	sbcl --no-userinit --eval '(require :asdf)' \
-	--eval '(let ((asdf:*central-registry* (list "../"))) (require :alexandria))' \
-	--load docstrings.lisp \
-	--eval '(sb-texinfo:generate-includes "include/" (list :alexandria) :base-package :alexandria)' \
-	--eval '(quit)'
-
-pdf: include
-	texi2pdf alexandria.texinfo
-
-html: include
-	makeinfo --html --no-split alexandria.texinfo
-
-info: include
-	makeinfo alexandria.texinfo
diff --git a/third_party/lisp/alexandria/doc/alexandria.texinfo b/third_party/lisp/alexandria/doc/alexandria.texinfo
deleted file mode 100644
index 89b03ac34967..000000000000
--- a/third_party/lisp/alexandria/doc/alexandria.texinfo
+++ /dev/null
@@ -1,277 +0,0 @@
-\input texinfo   @c -*-texinfo-*-
-@c %**start of header
-@setfilename alexandria.info
-@settitle Alexandria Manual
-@c %**end of header
-
-@settitle Alexandria Manual -- draft version
-
-@c for install-info
-@dircategory Software development
-@direntry
-* alexandria:           Common Lisp utilities.
-@end direntry
-
-@copying
-Alexandria software and associated documentation are in the public
-domain:
-
-@quotation
-  Authors dedicate this work to public domain, for the benefit of the
-  public at large and to the detriment of the authors' heirs and
-  successors. Authors intends this dedication to be an overt act of
-  relinquishment in perpetuity of all present and future rights under
-  copyright law, whether vested or contingent, in the work. Authors
-  understands that such relinquishment of all rights includes the
-  relinquishment of all rights to enforce (by lawsuit or otherwise)
-  those copyrights in the work.
-
-  Authors recognize that, once placed in the public domain, the work
-  may be freely reproduced, distributed, transmitted, used, modified,
-  built upon, or otherwise exploited by anyone for any purpose,
-  commercial or non-commercial, and in any way, including by methods
-  that have not yet been invented or conceived.
-@end quotation
-
-In those legislations where public domain dedications are not
-recognized or possible, Alexandria is distributed under the following
-terms and conditions:
-
-@quotation
-  Permission is hereby granted, free of charge, to any person
-  obtaining a copy of this software and associated documentation files
-  (the "Software"), to deal in the Software without restriction,
-  including without limitation the rights to use, copy, modify, merge,
-  publish, distribute, sublicense, and/or sell copies of the Software,
-  and to permit persons to whom the Software is furnished to do so,
-  subject to the following conditions:
-
-  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-@end quotation
-@end copying
-
-@titlepage
-
-@title Alexandria Manual
-@subtitle draft version
-
-@c The following two commands start the copyright page.
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-
-@end titlepage
-
-@contents
-
-@ifnottex
-
-@include include/ifnottex.texinfo
-
-@node Top
-@comment  node-name,  next,  previous,  up
-@top Alexandria
-
-@insertcopying
-
-@menu
-* Hash Tables::
-* Data and Control Flow::
-* Conses::
-* Sequences::
-* IO::
-* Macro Writing::
-* Symbols::
-* Arrays::
-* Types::
-* Numbers::
-@end menu
-
-@end ifnottex
-
-@node Hash Tables
-@comment  node-name,  next,  previous,  up
-@chapter Hash Tables
-
-@include include/macro-alexandria-ensure-gethash.texinfo
-@include include/fun-alexandria-copy-hash-table.texinfo
-@include include/fun-alexandria-maphash-keys.texinfo
-@include include/fun-alexandria-maphash-values.texinfo
-@include include/fun-alexandria-hash-table-keys.texinfo
-@include include/fun-alexandria-hash-table-values.texinfo
-@include include/fun-alexandria-hash-table-alist.texinfo
-@include include/fun-alexandria-hash-table-plist.texinfo
-@include include/fun-alexandria-alist-hash-table.texinfo
-@include include/fun-alexandria-plist-hash-table.texinfo
-
-@node Data and Control Flow
-@comment  node-name,  next,  previous,  up
-@chapter Data and Control Flow
-
-@include include/macro-alexandria-define-constant.texinfo
-@include include/macro-alexandria-destructuring-case.texinfo
-@include include/macro-alexandria-ensure-functionf.texinfo
-@include include/macro-alexandria-multiple-value-prog2.texinfo
-@include include/macro-alexandria-named-lambda.texinfo
-@include include/macro-alexandria-nth-value-or.texinfo
-@include include/macro-alexandria-if-let.texinfo
-@include include/macro-alexandria-when-let.texinfo
-@include include/macro-alexandria-when-let-star.texinfo
-@include include/macro-alexandria-switch.texinfo
-@include include/macro-alexandria-cswitch.texinfo
-@include include/macro-alexandria-eswitch.texinfo
-@include include/macro-alexandria-whichever.texinfo
-@include include/macro-alexandria-xor.texinfo
-
-@include include/fun-alexandria-disjoin.texinfo
-@include include/fun-alexandria-conjoin.texinfo
-@include include/fun-alexandria-compose.texinfo
-@include include/fun-alexandria-ensure-function.texinfo
-@include include/fun-alexandria-multiple-value-compose.texinfo
-@include include/fun-alexandria-curry.texinfo
-@include include/fun-alexandria-rcurry.texinfo
-
-@node Conses
-@comment  node-name,  next,  previous,  up
-@chapter Conses
-
-@include include/type-alexandria-proper-list.texinfo
-@include include/type-alexandria-circular-list.texinfo
-
-@include include/macro-alexandria-appendf.texinfo
-@include include/macro-alexandria-nconcf.texinfo
-@include include/macro-alexandria-remove-from-plistf.texinfo
-@include include/macro-alexandria-delete-from-plistf.texinfo
-@include include/macro-alexandria-reversef.texinfo
-@include include/macro-alexandria-nreversef.texinfo
-@include include/macro-alexandria-unionf.texinfo
-@include include/macro-alexandria-nunionf.texinfo
-
-@include include/macro-alexandria-doplist.texinfo
-
-@include include/fun-alexandria-circular-list-p.texinfo
-@include include/fun-alexandria-circular-tree-p.texinfo
-@include include/fun-alexandria-proper-list-p.texinfo
-
-@include include/fun-alexandria-alist-plist.texinfo
-@include include/fun-alexandria-plist-alist.texinfo
-@include include/fun-alexandria-circular-list.texinfo
-@include include/fun-alexandria-make-circular-list.texinfo
-@include include/fun-alexandria-ensure-car.texinfo
-@include include/fun-alexandria-ensure-cons.texinfo
-@include include/fun-alexandria-ensure-list.texinfo
-@include include/fun-alexandria-flatten.texinfo
-@include include/fun-alexandria-lastcar.texinfo
-@include include/fun-alexandria-setf-lastcar.texinfo
-@include include/fun-alexandria-proper-list-length.texinfo
-@include include/fun-alexandria-mappend.texinfo
-@include include/fun-alexandria-map-product.texinfo
-@include include/fun-alexandria-remove-from-plist.texinfo
-@include include/fun-alexandria-delete-from-plist.texinfo
-@include include/fun-alexandria-set-equal.texinfo
-@include include/fun-alexandria-setp.texinfo
-
-@node Sequences
-@comment  node-name,  next,  previous,  up
-@chapter Sequences
-
-@include include/type-alexandria-proper-sequence.texinfo
-
-@include include/macro-alexandria-deletef.texinfo
-@include include/macro-alexandria-removef.texinfo
-
-@include include/fun-alexandria-rotate.texinfo
-@include include/fun-alexandria-shuffle.texinfo
-@include include/fun-alexandria-random-elt.texinfo
-@include include/fun-alexandria-emptyp.texinfo
-@include include/fun-alexandria-sequence-of-length-p.texinfo
-@include include/fun-alexandria-length-equals.texinfo
-@include include/fun-alexandria-copy-sequence.texinfo
-@include include/fun-alexandria-first-elt.texinfo
-@include include/fun-alexandria-setf-first-elt.texinfo
-@include include/fun-alexandria-last-elt.texinfo
-@include include/fun-alexandria-setf-last-elt.texinfo
-@include include/fun-alexandria-starts-with.texinfo
-@include include/fun-alexandria-starts-with-subseq.texinfo
-@include include/fun-alexandria-ends-with.texinfo
-@include include/fun-alexandria-ends-with-subseq.texinfo
-@include include/fun-alexandria-map-combinations.texinfo
-@include include/fun-alexandria-map-derangements.texinfo
-@include include/fun-alexandria-map-permutations.texinfo
-
-@node IO
-@comment  node-name,   next,  previous,  up
-@chapter IO
-
-@include include/fun-alexandria-read-stream-content-into-string.texinfo
-@include include/fun-alexandria-read-file-into-string.texinfo
-@include include/fun-alexandria-read-stream-content-into-byte-vector.texinfo
-@include include/fun-alexandria-read-file-into-byte-vector.texinfo
-
-@node Macro Writing
-@comment  node-name,  next,  previous,  up
-@chapter Macro Writing
-
-@include include/macro-alexandria-once-only.texinfo
-@include include/macro-alexandria-with-gensyms.texinfo
-@include include/macro-alexandria-with-unique-names.texinfo
-@include include/fun-alexandria-featurep.texinfo
-@include include/fun-alexandria-parse-body.texinfo
-@include include/fun-alexandria-parse-ordinary-lambda-list.texinfo
-
-@node Symbols
-@comment  node-name,  next,  previous,  up
-@chapter Symbols
-
-@include include/fun-alexandria-ensure-symbol.texinfo
-@include include/fun-alexandria-format-symbol.texinfo
-@include include/fun-alexandria-make-keyword.texinfo
-@include include/fun-alexandria-make-gensym.texinfo
-@include include/fun-alexandria-make-gensym-list.texinfo
-@include include/fun-alexandria-symbolicate.texinfo
-
-@node Arrays
-@comment  node-name,  next,  previous,  up
-@chapter Arrays
-
-@include include/type-alexandria-array-index.texinfo
-@include include/type-alexandria-array-length.texinfo
-@include include/fun-alexandria-copy-array.texinfo
-
-@node Types
-@comment  node-name,  next,  previous,  up
-@chapter Types
-
-@include include/type-alexandria-string-designator.texinfo
-@include include/macro-alexandria-coercef.texinfo
-@include include/fun-alexandria-of-type.texinfo
-@include include/fun-alexandria-type-equals.texinfo
-
-@node Numbers
-@comment  node-name,  next,  previous,  up
-@chapter Numbers
-
-@include include/macro-alexandria-maxf.texinfo
-@include include/macro-alexandria-minf.texinfo
-
-@include include/fun-alexandria-binomial-coefficient.texinfo
-@include include/fun-alexandria-count-permutations.texinfo
-@include include/fun-alexandria-clamp.texinfo
-@include include/fun-alexandria-lerp.texinfo
-@include include/fun-alexandria-factorial.texinfo
-@include include/fun-alexandria-subfactorial.texinfo
-@include include/fun-alexandria-gaussian-random.texinfo
-@include include/fun-alexandria-iota.texinfo
-@include include/fun-alexandria-map-iota.texinfo
-@include include/fun-alexandria-mean.texinfo
-@include include/fun-alexandria-median.texinfo
-@include include/fun-alexandria-variance.texinfo
-@include include/fun-alexandria-standard-deviation.texinfo
-
-@bye
diff --git a/third_party/lisp/alexandria/doc/docstrings.lisp b/third_party/lisp/alexandria/doc/docstrings.lisp
deleted file mode 100644
index 51dda07d09b7..000000000000
--- a/third_party/lisp/alexandria/doc/docstrings.lisp
+++ /dev/null
@@ -1,881 +0,0 @@
-;;; -*- lisp -*-
-
-;;;; A docstring extractor for the sbcl manual.  Creates
-;;;; @include-ready documentation from the docstrings of exported
-;;;; symbols of specified packages.
-
-;;;; This software is part of the SBCL software system. SBCL is in the
-;;;; public domain and is provided with absolutely no warranty. See
-;;;; the COPYING file for more information.
-;;;;
-;;;; Written by Rudi Schlatte <rudi@constantly.at>, mangled
-;;;; by Nikodemus Siivola.
-
-;;;; TODO
-;;;; * Verbatim text
-;;;; * Quotations
-;;;; * Method documentation untested
-;;;; * Method sorting, somehow
-;;;; * Index for macros & constants?
-;;;; * This is getting complicated enough that tests would be good
-;;;; * Nesting (currently only nested itemizations work)
-;;;; * doc -> internal form -> texinfo (so that non-texinfo format are also
-;;;;   easily generated)
-
-;;;; FIXME: The description below is no longer complete. This
-;;;; should possibly be turned into a contrib with proper documentation.
-
-;;;; Formatting heuristics (tweaked to format SAVE-LISP-AND-DIE sanely):
-;;;;
-;;;; Formats SYMBOL as @code{symbol}, or @var{symbol} if symbol is in
-;;;; the argument list of the defun / defmacro.
-;;;;
-;;;; Lines starting with * or - that are followed by intented lines
-;;;; are marked up with @itemize.
-;;;;
-;;;; Lines containing only a SYMBOL that are followed by indented
-;;;; lines are marked up as @table @code, with the SYMBOL as the item.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (require 'sb-introspect))
-
-(defpackage :sb-texinfo
-  (:use :cl :sb-mop)
-  (:shadow #:documentation)
-  (:export #:generate-includes #:document-package)
-  (:documentation
-   "Tools to generate TexInfo documentation from docstrings."))
-
-(in-package :sb-texinfo)
-
-;;;; various specials and parameters
-
-(defvar *texinfo-output*)
-(defvar *texinfo-variables*)
-(defvar *documentation-package*)
-(defvar *base-package*)
-
-(defparameter *undocumented-packages* '(sb-pcl sb-int sb-kernel sb-sys sb-c))
-
-(defparameter *documentation-types*
-  '(compiler-macro
-    function
-    method-combination
-    setf
-    ;;structure  ; also handled by `type'
-    type
-    variable)
-  "A list of symbols accepted as second argument of `documentation'")
-
-(defparameter *character-replacements*
-  '((#\* . "star") (#\/ . "slash") (#\+ . "plus")
-    (#\< . "lt") (#\> . "gt")
-    (#\= . "equals"))
-  "Characters and their replacement names that `alphanumize' uses. If
-the replacements contain any of the chars they're supposed to replace,
-you deserve to lose.")
-
-(defparameter *characters-to-drop* '(#\\ #\` #\')
-  "Characters that should be removed by `alphanumize'.")
-
-(defparameter *texinfo-escaped-chars* "@{}"
-  "Characters that must be escaped with #\@ for Texinfo.")
-
-(defparameter *itemize-start-characters* '(#\* #\-)
-  "Characters that might start an itemization in docstrings when
-  at the start of a line.")
-
-(defparameter *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890*:-+&#'"
-  "List of characters that make up symbols in a docstring.")
-
-(defparameter *symbol-delimiters* " ,.!?;")
-
-(defparameter *ordered-documentation-kinds*
-  '(package type structure condition class macro))
-
-;;;; utilities
-
-(defun flatten (list)
-  (cond ((null list)
-         nil)
-        ((consp (car list))
-         (nconc (flatten (car list)) (flatten (cdr list))))
-        ((null (cdr list))
-         (cons (car list) nil))
-        (t
-         (cons (car list) (flatten (cdr list))))))
-
-(defun whitespacep (char)
-  (find char #(#\tab #\space #\page)))
-
-(defun setf-name-p (name)
-  (or (symbolp name)
-      (and (listp name) (= 2 (length name)) (eq (car name) 'setf))))
-
-(defgeneric specializer-name (specializer))
-
-(defmethod specializer-name ((specializer eql-specializer))
-  (list 'eql (eql-specializer-object specializer)))
-
-(defmethod specializer-name ((specializer class))
-  (class-name specializer))
-
-(defun ensure-class-precedence-list (class)
-  (unless (class-finalized-p class)
-    (finalize-inheritance class))
-  (class-precedence-list class))
-
-(defun specialized-lambda-list (method)
-  ;; courtecy of AMOP p. 61
-  (let* ((specializers (method-specializers method))
-         (lambda-list (method-lambda-list method))
-         (n-required (length specializers)))
-    (append (mapcar (lambda (arg specializer)
-                      (if  (eq specializer (find-class 't))
-                           arg
-                           `(,arg ,(specializer-name specializer))))
-                    (subseq lambda-list 0 n-required)
-                    specializers)
-           (subseq lambda-list n-required))))
-
-(defun string-lines (string)
-  "Lines in STRING as a vector."
-  (coerce (with-input-from-string (s string)
-            (loop for line = (read-line s nil nil)
-               while line collect line))
-          'vector))
-
-(defun indentation (line)
-  "Position of first non-SPACE character in LINE."
-  (position-if-not (lambda (c) (char= c #\Space)) line))
-
-(defun docstring (x doc-type)
-  (cl:documentation x doc-type))
-
-(defun flatten-to-string (list)
-  (format nil "~{~A~^-~}" (flatten list)))
-
-(defun alphanumize (original)
-  "Construct a string without characters like *`' that will f-star-ck
-up filename handling. See `*character-replacements*' and
-`*characters-to-drop*' for customization."
-  (let ((name (remove-if (lambda (x) (member x *characters-to-drop*))
-                         (if (listp original)
-                             (flatten-to-string original)
-                             (string original))))
-        (chars-to-replace (mapcar #'car *character-replacements*)))
-    (flet ((replacement-delimiter (index)
-             (cond ((or (< index 0) (>= index (length name))) "")
-                   ((alphanumericp (char name index)) "-")
-                   (t ""))))
-      (loop for index = (position-if #'(lambda (x) (member x chars-to-replace))
-                                     name)
-         while index
-         do (setf name (concatenate 'string (subseq name 0 index)
-                                    (replacement-delimiter (1- index))
-                                    (cdr (assoc (aref name index)
-                                                *character-replacements*))
-                                    (replacement-delimiter (1+ index))
-                                    (subseq name (1+ index))))))
-    name))
-
-;;;; generating various names
-
-(defgeneric name (thing)
-  (:documentation "Name for a documented thing. Names are either
-symbols or lists of symbols."))
-
-(defmethod name ((symbol symbol))
-  symbol)
-
-(defmethod name ((cons cons))
-  cons)
-
-(defmethod name ((package package))
-  (short-package-name package))
-
-(defmethod name ((method method))
-  (list
-   (generic-function-name (method-generic-function method))
-   (method-qualifiers method)
-   (specialized-lambda-list method)))
-
-;;; Node names for DOCUMENTATION instances
-
-(defgeneric name-using-kind/name (kind name doc))
-
-(defmethod name-using-kind/name (kind (name string) doc)
-  (declare (ignore kind doc))
-  name)
-
-(defmethod name-using-kind/name (kind (name symbol) doc)
-  (declare (ignore kind))
-  (format nil "~@[~A:~]~A" (short-package-name (get-package doc)) name))
-
-(defmethod name-using-kind/name (kind (name list) doc)
-  (declare (ignore kind))
-  (assert (setf-name-p name))
-  (format nil "(setf ~@[~A:~]~A)" (short-package-name (get-package doc)) (second name)))
-
-(defmethod name-using-kind/name ((kind (eql 'method)) name doc)
-  (format nil "~A~{ ~A~} ~A"
-          (name-using-kind/name nil (first name) doc)
-          (second name)
-          (third name)))
-
-(defun node-name (doc)
-  "Returns TexInfo node name as a string for a DOCUMENTATION instance."
-  (let ((kind (get-kind doc)))
-    (format nil "~:(~A~) ~(~A~)" kind (name-using-kind/name kind (get-name doc) doc))))
-
-(defun short-package-name (package)
-  (unless (eq package *base-package*)
-    (car (sort (copy-list (cons (package-name package) (package-nicknames package)))
-               #'< :key #'length))))
-
-;;; Definition titles for DOCUMENTATION instances
-
-(defgeneric title-using-kind/name (kind name doc))
-
-(defmethod title-using-kind/name (kind (name string) doc)
-  (declare (ignore kind doc))
-  name)
-
-(defmethod title-using-kind/name (kind (name symbol) doc)
-  (declare (ignore kind))
-  (format nil "~@[~A:~]~A" (short-package-name (get-package doc)) name))
-
-(defmethod title-using-kind/name (kind (name list) doc)
-  (declare (ignore kind))
-  (assert (setf-name-p name))
-  (format nil "(setf ~@[~A:~]~A)" (short-package-name (get-package doc)) (second name)))
-
-(defmethod title-using-kind/name ((kind (eql 'method)) name doc)
-  (format nil "~{~A ~}~A"
-          (second name)
-          (title-using-kind/name nil (first name) doc)))
-
-(defun title-name (doc)
-  "Returns a string to be used as name of the definition."
-  (string-downcase (title-using-kind/name (get-kind doc) (get-name doc) doc)))
-
-(defun include-pathname (doc)
-  (let* ((kind (get-kind doc))
-         (name (nstring-downcase
-                (if (eq 'package kind)
-                    (format nil "package-~A" (alphanumize (get-name doc)))
-                    (format nil "~A-~A-~A"
-                            (case (get-kind doc)
-                              ((function generic-function) "fun")
-                              (structure "struct")
-                              (variable "var")
-                              (otherwise (symbol-name (get-kind doc))))
-                            (alphanumize (let ((*base-package* nil))
-                                           (short-package-name (get-package doc))))
-                            (alphanumize (get-name doc)))))))
-    (make-pathname :name name  :type "texinfo")))
-
-;;;; documentation class and related methods
-
-(defclass documentation ()
-  ((name :initarg :name :reader get-name)
-   (kind :initarg :kind :reader get-kind)
-   (string :initarg :string :reader get-string)
-   (children :initarg :children :initform nil :reader get-children)
-   (package :initform *documentation-package* :reader get-package)))
-
-(defmethod print-object ((documentation documentation) stream)
-  (print-unreadable-object (documentation stream :type t)
-    (princ (list (get-kind documentation) (get-name documentation)) stream)))
-
-(defgeneric make-documentation (x doc-type string))
-
-(defmethod make-documentation ((x package) doc-type string)
-  (declare (ignore doc-type))
-  (make-instance 'documentation
-                 :name (name x)
-                 :kind 'package
-                 :string string))
-
-(defmethod make-documentation (x (doc-type (eql 'function)) string)
-  (declare (ignore doc-type))
-  (let* ((fdef (and (fboundp x) (fdefinition x)))
-         (name x)
-         (kind (cond ((and (symbolp x) (special-operator-p x))
-                      'special-operator)
-                     ((and (symbolp x) (macro-function x))
-                      'macro)
-                     ((typep fdef 'generic-function)
-                      (assert (or (symbolp name) (setf-name-p name)))
-                      'generic-function)
-                     (fdef
-                      (assert (or (symbolp name) (setf-name-p name)))
-                      'function)))
-         (children (when (eq kind 'generic-function)
-                     (collect-gf-documentation fdef))))
-    (make-instance 'documentation
-                   :name (name x)
-                   :string string
-                   :kind kind
-                   :children children)))
-
-(defmethod make-documentation ((x method) doc-type string)
-  (declare (ignore doc-type))
-  (make-instance 'documentation
-                 :name (name x)
-                 :kind 'method
-                 :string string))
-
-(defmethod make-documentation (x (doc-type (eql 'type)) string)
-  (make-instance 'documentation
-                 :name (name x)
-                 :string string
-                 :kind (etypecase (find-class x nil)
-                         (structure-class 'structure)
-                         (standard-class 'class)
-                         (sb-pcl::condition-class 'condition)
-                         ((or built-in-class null) 'type))))
-
-(defmethod make-documentation (x (doc-type (eql 'variable)) string)
-  (make-instance 'documentation
-                 :name (name x)
-                 :string string
-                 :kind (if (constantp x)
-                           'constant
-                           'variable)))
-
-(defmethod make-documentation (x (doc-type (eql 'setf)) string)
-  (declare (ignore doc-type))
-  (make-instance 'documentation
-                 :name (name x)
-                 :kind 'setf-expander
-                 :string string))
-
-(defmethod make-documentation (x doc-type string)
-  (make-instance 'documentation
-                 :name (name x)
-                 :kind doc-type
-                 :string string))
-
-(defun maybe-documentation (x doc-type)
-  "Returns a DOCUMENTATION instance for X and DOC-TYPE, or NIL if
-there is no corresponding docstring."
-  (let ((docstring (docstring x doc-type)))
-    (when docstring
-      (make-documentation x doc-type docstring))))
-
-(defun lambda-list (doc)
-  (case (get-kind doc)
-    ((package constant variable type structure class condition nil)
-     nil)
-    (method
-     (third (get-name doc)))
-    (t
-     ;; KLUDGE: Eugh.
-     ;;
-     ;; believe it or not, the above comment was written before CSR
-     ;; came along and obfuscated this.  (2005-07-04)
-     (when (symbolp (get-name doc))
-       (labels ((clean (x &key optional key)
-                  (typecase x
-                    (atom x)
-                    ((cons (member &optional))
-                     (cons (car x) (clean (cdr x) :optional t)))
-                    ((cons (member &key))
-                     (cons (car x) (clean (cdr x) :key t)))
-                    ((cons (member &whole &environment))
-                     ;; Skip these
-                     (clean (cdr x) :optional optional :key key))
-                    ((cons cons)
-                     (cons
-                      (cond (key (if (consp (caar x))
-                                     (caaar x)
-                                     (caar x)))
-                            (optional (caar x))
-                            (t (clean (car x))))
-                      (clean (cdr x) :key key :optional optional)))
-                    (cons
-                     (cons
-                      (cond ((or key optional) (car x))
-                            (t (clean (car x))))
-                      (clean (cdr x) :key key :optional optional))))))
-         (clean (sb-introspect:function-lambda-list (get-name doc))))))))
-
-(defun get-string-name (x)
-  (let ((name (get-name x)))
-    (cond ((symbolp name)
-           (symbol-name name))
-          ((and (consp name) (eq 'setf (car name)))
-           (symbol-name (second name)))
-          ((stringp name)
-           name)
-          (t
-           (error "Don't know which symbol to use for name ~S" name)))))
-
-(defun documentation< (x y)
-  (let ((p1 (position (get-kind x) *ordered-documentation-kinds*))
-        (p2 (position (get-kind y) *ordered-documentation-kinds*)))
-    (if (or (not (and p1 p2)) (= p1 p2))
-        (string< (get-string-name x) (get-string-name y))
-        (< p1 p2))))
-
-;;;; turning text into texinfo
-
-(defun escape-for-texinfo (string &optional downcasep)
-  "Return STRING with characters in *TEXINFO-ESCAPED-CHARS* escaped
-with #\@. Optionally downcase the result."
-  (let ((result (with-output-to-string (s)
-                  (loop for char across string
-                        when (find char *texinfo-escaped-chars*)
-                        do (write-char #\@ s)
-                        do (write-char char s)))))
-    (if downcasep (nstring-downcase result) result)))
-
-(defun empty-p (line-number lines)
-  (and (< -1 line-number (length lines))
-       (not (indentation (svref lines line-number)))))
-
-;;; line markups
-
-(defvar *not-symbols* '("ANSI" "CLHS"))
-
-(defun locate-symbols (line)
-  "Return a list of index pairs of symbol-like parts of LINE."
-  ;; This would be a good application for a regex ...
-  (let (result)
-    (flet ((grab (start end)
-             (unless (member (subseq line start end) '("ANSI" "CLHS"))
-               (push (list start end) result))))
-      (do ((begin nil)
-           (maybe-begin t)
-           (i 0 (1+ i)))
-          ((= i (length line))
-           ;; symbol at end of line
-           (when (and begin (or (> i (1+ begin))
-                                (not (member (char line begin) '(#\A #\I)))))
-             (grab begin i))
-           (nreverse result))
-        (cond
-          ((and begin (find (char line i) *symbol-delimiters*))
-           ;; symbol end; remember it if it's not "A" or "I"
-           (when (or (> i (1+ begin)) (not (member (char line begin) '(#\A #\I))))
-             (grab begin i))
-           (setf begin nil
-                 maybe-begin t))
-          ((and begin (not (find (char line i) *symbol-characters*)))
-           ;; Not a symbol: abort
-           (setf begin nil))
-          ((and maybe-begin (not begin) (find (char line i) *symbol-characters*))
-           ;; potential symbol begin at this position
-           (setf begin i
-                 maybe-begin nil))
-          ((find (char line i) *symbol-delimiters*)
-           ;; potential symbol begin after this position
-           (setf maybe-begin t))
-          (t
-           ;; Not reading a symbol, not at potential start of symbol
-           (setf maybe-begin nil)))))))
-
-(defun texinfo-line (line)
-  "Format symbols in LINE texinfo-style: either as code or as
-variables if the symbol in question is contained in symbols
-*TEXINFO-VARIABLES*."
-  (with-output-to-string (result)
-    (let ((last 0))
-      (dolist (symbol/index (locate-symbols line))
-        (write-string (subseq line last (first symbol/index)) result)
-        (let ((symbol-name (apply #'subseq line symbol/index)))
-          (format result (if (member symbol-name *texinfo-variables*
-                                     :test #'string=)
-                             "@var{~A}"
-                             "@code{~A}")
-                  (string-downcase symbol-name)))
-        (setf last (second symbol/index)))
-      (write-string (subseq line last) result))))
-
-;;; lisp sections
-
-(defun lisp-section-p (line line-number lines)
-  "Returns T if the given LINE looks like start of lisp code --
-ie. if it starts with whitespace followed by a paren or
-semicolon, and the previous line is empty"
-  (let ((offset (indentation line)))
-    (and offset
-         (plusp offset)
-         (find (find-if-not #'whitespacep line) "(;")
-         (empty-p (1- line-number) lines))))
-
-(defun collect-lisp-section (lines line-number)
-  (let ((lisp (loop for index = line-number then (1+ index)
-                    for line = (and (< index (length lines)) (svref lines index))
-                    while (indentation line)
-                    collect line)))
-    (values (length lisp) `("@lisp" ,@lisp "@end lisp"))))
-
-;;; itemized sections
-
-(defun maybe-itemize-offset (line)
-  "Return NIL or the indentation offset if LINE looks like it starts
-an item in an itemization."
-  (let* ((offset (indentation line))
-         (char (when offset (char line offset))))
-    (and offset
-         (member char *itemize-start-characters* :test #'char=)
-         (char= #\Space (find-if-not (lambda (c) (char= c char))
-                                     line :start offset))
-         offset)))
-
-(defun collect-maybe-itemized-section (lines starting-line)
-  ;; Return index of next line to be processed outside
-  (let ((this-offset (maybe-itemize-offset (svref lines starting-line)))
-        (result nil)
-        (lines-consumed 0))
-    (loop for line-number from starting-line below (length lines)
-       for line = (svref lines line-number)
-       for indentation = (indentation line)
-       for offset = (maybe-itemize-offset line)
-       do (cond
-            ((not indentation)
-             ;; empty line -- inserts paragraph.
-             (push "" result)
-             (incf lines-consumed))
-            ((and offset (> indentation this-offset))
-             ;; nested itemization -- handle recursively
-             ;; FIXME: tables in itemizations go wrong
-             (multiple-value-bind (sub-lines-consumed sub-itemization)
-                 (collect-maybe-itemized-section lines line-number)
-               (when sub-lines-consumed
-                 (incf line-number (1- sub-lines-consumed)) ; +1 on next loop
-                 (incf lines-consumed sub-lines-consumed)
-                 (setf result (nconc (nreverse sub-itemization) result)))))
-            ((and offset (= indentation this-offset))
-             ;; start of new item
-             (push (format nil "@item ~A"
-                           (texinfo-line (subseq line (1+ offset))))
-                   result)
-             (incf lines-consumed))
-            ((and (not offset) (> indentation this-offset))
-             ;; continued item from previous line
-             (push (texinfo-line line) result)
-             (incf lines-consumed))
-            (t
-             ;; end of itemization
-             (loop-finish))))
-    ;; a single-line itemization isn't.
-    (if (> (count-if (lambda (line) (> (length line) 0)) result) 1)
-        (values lines-consumed `("@itemize" ,@(reverse result) "@end itemize"))
-        nil)))
-
-;;; table sections
-
-(defun tabulation-body-p (offset line-number lines)
-  (when (< line-number (length lines))
-    (let ((offset2 (indentation (svref lines line-number))))
-      (and offset2 (< offset offset2)))))
-
-(defun tabulation-p (offset line-number lines direction)
-  (let ((step  (ecase direction
-                 (:backwards (1- line-number))
-                 (:forwards (1+ line-number)))))
-    (when (and (plusp line-number) (< line-number (length lines)))
-      (and (eql offset (indentation (svref lines line-number)))
-           (or (when (eq direction :backwards)
-                 (empty-p step lines))
-               (tabulation-p offset step lines direction)
-               (tabulation-body-p offset step lines))))))
-
-(defun maybe-table-offset (line-number lines)
-  "Return NIL or the indentation offset if LINE looks like it starts
-an item in a tabulation. Ie, if it is (1) indented, (2) preceded by an
-empty line, another tabulation label, or a tabulation body, (3) and
-followed another tabulation label or a tabulation body."
-  (let* ((line (svref lines line-number))
-         (offset (indentation line))
-         (prev (1- line-number))
-         (next (1+ line-number)))
-    (when (and offset (plusp offset))
-      (and (or (empty-p prev lines)
-               (tabulation-body-p offset prev lines)
-               (tabulation-p offset prev lines :backwards))
-           (or (tabulation-body-p offset next lines)
-               (tabulation-p offset next lines :forwards))
-           offset))))
-
-;;; FIXME: This and itemization are very similar: could they share
-;;; some code, mayhap?
-
-(defun collect-maybe-table-section (lines starting-line)
-  ;; Return index of next line to be processed outside
-  (let ((this-offset (maybe-table-offset starting-line lines))
-        (result nil)
-        (lines-consumed 0))
-    (loop for line-number from starting-line below (length lines)
-          for line = (svref lines line-number)
-          for indentation = (indentation line)
-          for offset = (maybe-table-offset line-number lines)
-          do (cond
-               ((not indentation)
-                ;; empty line -- inserts paragraph.
-                (push "" result)
-                (incf lines-consumed))
-               ((and offset (= indentation this-offset))
-                ;; start of new item, or continuation of previous item
-                (if (and result (search "@item" (car result) :test #'char=))
-                    (push (format nil "@itemx ~A" (texinfo-line line))
-                          result)
-                    (progn
-                      (push "" result)
-                      (push (format nil "@item ~A" (texinfo-line line))
-                            result)))
-                (incf lines-consumed))
-               ((> indentation this-offset)
-                ;; continued item from previous line
-                (push (texinfo-line line) result)
-                (incf lines-consumed))
-               (t
-                ;; end of itemization
-                (loop-finish))))
-     ;; a single-line table isn't.
-    (if (> (count-if (lambda (line) (> (length line) 0)) result) 1)
-        (values lines-consumed
-                `("" "@table @emph" ,@(reverse result) "@end table" ""))
-        nil)))
-
-;;; section markup
-
-(defmacro with-maybe-section (index &rest forms)
-  `(multiple-value-bind (count collected) (progn ,@forms)
-    (when count
-      (dolist (line collected)
-        (write-line line *texinfo-output*))
-      (incf ,index (1- count)))))
-
-(defun write-texinfo-string (string &optional lambda-list)
-  "Try to guess as much formatting for a raw docstring as possible."
-  (let ((*texinfo-variables* (flatten lambda-list))
-        (lines (string-lines (escape-for-texinfo string nil))))
-      (loop for line-number from 0 below (length lines)
-            for line = (svref lines line-number)
-            do (cond
-                 ((with-maybe-section line-number
-                    (and (lisp-section-p line line-number lines)
-                         (collect-lisp-section lines line-number))))
-                 ((with-maybe-section line-number
-                    (and (maybe-itemize-offset line)
-                         (collect-maybe-itemized-section lines line-number))))
-                 ((with-maybe-section line-number
-                    (and (maybe-table-offset line-number lines)
-                         (collect-maybe-table-section lines line-number))))
-                 (t
-                  (write-line (texinfo-line line) *texinfo-output*))))))
-
-;;;; texinfo formatting tools
-
-(defun hide-superclass-p (class-name super-name)
-  (let ((super-package (symbol-package super-name)))
-    (or
-     ;; KLUDGE: We assume that we don't want to advertise internal
-     ;; classes in CP-lists, unless the symbol we're documenting is
-     ;; internal as well.
-     (and (member super-package #.'(mapcar #'find-package *undocumented-packages*))
-          (not (eq super-package (symbol-package class-name))))
-     ;; KLUDGE: We don't generally want to advertise SIMPLE-ERROR or
-     ;; SIMPLE-CONDITION in the CPLs of conditions that inherit them
-     ;; simply as a matter of convenience. The assumption here is that
-     ;; the inheritance is incidental unless the name of the condition
-     ;; begins with SIMPLE-.
-     (and (member super-name '(simple-error simple-condition))
-          (let ((prefix "SIMPLE-"))
-            (mismatch prefix (string class-name) :end2 (length prefix)))
-          t ; don't return number from MISMATCH
-          ))))
-
-(defun hide-slot-p (symbol slot)
-  ;; FIXME: There is no pricipal reason to avoid the slot docs fo
-  ;; structures and conditions, but their DOCUMENTATION T doesn't
-  ;; currently work with them the way we'd like.
-  (not (and (typep (find-class symbol nil) 'standard-class)
-            (docstring slot t))))
-
-(defun texinfo-anchor (doc)
-  (format *texinfo-output* "@anchor{~A}~%" (node-name doc)))
-
-;;; KLUDGE: &AUX *PRINT-PRETTY* here means "no linebreaks please"
-(defun texinfo-begin (doc &aux *print-pretty*)
-  (let ((kind (get-kind doc)))
-    (format *texinfo-output* "@~A {~:(~A~)} ~({~A}~@[ ~{~A~^ ~}~]~)~%"
-            (case kind
-              ((package constant variable)
-               "defvr")
-              ((structure class condition type)
-               "deftp")
-              (t
-               "deffn"))
-            (map 'string (lambda (char) (if (eql char #\-) #\Space char)) (string kind))
-            (title-name doc)
-            ;; &foo would be amusingly bold in the pdf thanks to TeX/Texinfo
-            ;; interactions,so we escape the ampersand -- amusingly for TeX.
-            ;; sbcl.texinfo defines macros that expand @&key and friends to &key.
-            (mapcar (lambda (name)
-                      (if (member name lambda-list-keywords)
-                          (format nil "@~A" name)
-                          name))
-                    (lambda-list doc)))))
-
-(defun texinfo-index (doc)
-  (let ((title (title-name doc)))
-    (case (get-kind doc)
-      ((structure type class condition)
-       (format *texinfo-output* "@tindex ~A~%" title))
-      ((variable constant)
-       (format *texinfo-output* "@vindex ~A~%" title))
-      ((compiler-macro function method-combination macro generic-function)
-       (format *texinfo-output* "@findex ~A~%" title)))))
-
-(defun texinfo-inferred-body (doc)
-  (when (member (get-kind doc) '(class structure condition))
-    (let ((name (get-name doc)))
-      ;; class precedence list
-      (format *texinfo-output* "Class precedence list: @code{~(~{@lw{~A}~^, ~}~)}~%~%"
-              (remove-if (lambda (class)  (hide-superclass-p name class))
-                         (mapcar #'class-name (ensure-class-precedence-list (find-class name)))))
-      ;; slots
-      (let ((slots (remove-if (lambda (slot) (hide-slot-p name slot))
-                              (class-direct-slots (find-class name)))))
-        (when slots
-          (format *texinfo-output* "Slots:~%@itemize~%")
-          (dolist (slot slots)
-            (format *texinfo-output*
-                    "@item ~(@code{~A}~#[~:; --- ~]~
-                      ~:{~2*~@[~2:*~A~P: ~{@code{@w{~S}}~^, ~}~]~:^; ~}~)~%~%"
-                    (slot-definition-name slot)
-                    (remove
-                     nil
-                     (mapcar
-                      (lambda (name things)
-                        (if things
-                            (list name (length things) things)))
-                      '("initarg" "reader"  "writer")
-                      (list
-                       (slot-definition-initargs slot)
-                       (slot-definition-readers slot)
-                       (slot-definition-writers slot)))))
-            ;; FIXME: Would be neater to handler as children
-            (write-texinfo-string (docstring slot t)))
-          (format *texinfo-output* "@end itemize~%~%"))))))
-
-(defun texinfo-body (doc)
-  (write-texinfo-string (get-string doc)))
-
-(defun texinfo-end (doc)
-  (write-line (case (get-kind doc)
-                ((package variable constant) "@end defvr")
-                ((structure type class condition) "@end deftp")
-                (t "@end deffn"))
-              *texinfo-output*))
-
-(defun write-texinfo (doc)
-  "Writes TexInfo for a DOCUMENTATION instance to *TEXINFO-OUTPUT*."
-  (texinfo-anchor doc)
-  (texinfo-begin doc)
-  (texinfo-index doc)
-  (texinfo-inferred-body doc)
-  (texinfo-body doc)
-  (texinfo-end doc)
-  ;; FIXME: Children should be sorted one way or another
-  (mapc #'write-texinfo (get-children doc)))
-
-;;;; main logic
-
-(defun collect-gf-documentation (gf)
-  "Collects method documentation for the generic function GF"
-  (loop for method in (generic-function-methods gf)
-        for doc = (maybe-documentation method t)
-        when doc
-        collect doc))
-
-(defun collect-name-documentation (name)
-  (loop for type in *documentation-types*
-        for doc = (maybe-documentation name type)
-        when doc
-        collect doc))
-
-(defun collect-symbol-documentation (symbol)
-  "Collects all docs for a SYMBOL and (SETF SYMBOL), returns a list of
-the form DOC instances. See `*documentation-types*' for the possible
-values of doc-type."
-  (nconc (collect-name-documentation symbol)
-         (collect-name-documentation (list 'setf symbol))))
-
-(defun collect-documentation (package)
-  "Collects all documentation for all external symbols of the given
-package, as well as for the package itself."
-  (let* ((*documentation-package* (find-package package))
-         (docs nil))
-    (check-type package package)
-    (do-external-symbols (symbol package)
-      (setf docs (nconc (collect-symbol-documentation symbol) docs)))
-    (let ((doc (maybe-documentation *documentation-package* t)))
-      (when doc
-        (push doc docs)))
-    docs))
-
-(defmacro with-texinfo-file (pathname &body forms)
-  `(with-open-file (*texinfo-output* ,pathname
-                                    :direction :output
-                                    :if-does-not-exist :create
-                                    :if-exists :supersede)
-    ,@forms))
-
-(defun write-ifnottex ()
-  ;; We use @&key, etc to escape & from TeX in lambda lists -- so we need to
-  ;; define them for info as well.
-  (flet ((macro (name)
-                 (let ((string (string-downcase name)))
-                   (format *texinfo-output* "@macro ~A~%~A~%@end macro~%" string string))))
-    (macro '&allow-other-keys)
-    (macro '&optional)
-    (macro '&rest)
-    (macro '&key)
-    (macro '&body)))
-
-(defun generate-includes (directory packages &key (base-package :cl-user))
-  "Create files in `directory' containing Texinfo markup of all
-docstrings of each exported symbol in `packages'. `directory' is
-created if necessary. If you supply a namestring that doesn't end in a
-slash, you lose. The generated files are of the form
-\"<doc-type>_<packagename>_<symbol-name>.texinfo\" and can be included
-via @include statements. Texinfo syntax-significant characters are
-escaped in symbol names, but if a docstring contains invalid Texinfo
-markup, you lose."
-  (handler-bind ((warning #'muffle-warning))
-    (let ((directory (merge-pathnames (pathname directory)))
-          (*base-package* (find-package base-package)))
-      (ensure-directories-exist directory)
-      (dolist (package packages)
-        (dolist (doc (collect-documentation (find-package package)))
-          (with-texinfo-file (merge-pathnames (include-pathname doc) directory)
-            (write-texinfo doc))))
-      (with-texinfo-file (merge-pathnames "ifnottex.texinfo" directory)
-        (write-ifnottex))
-      directory)))
-
-(defun document-package (package &optional filename)
-  "Create a file containing all available documentation for the
-exported symbols of `package' in Texinfo format. If `filename' is not
-supplied, a file \"<packagename>.texinfo\" is generated.
-
-The definitions can be referenced using Texinfo statements like
-@ref{<doc-type>_<packagename>_<symbol-name>.texinfo}. Texinfo
-syntax-significant characters are escaped in symbol names, but if a
-docstring contains invalid Texinfo markup, you lose."
-  (handler-bind ((warning #'muffle-warning))
-    (let* ((package (find-package package))
-           (filename (or filename (make-pathname
-                                   :name (string-downcase (short-package-name package))
-                                   :type "texinfo")))
-           (docs (sort (collect-documentation package) #'documentation<)))
-      (with-texinfo-file filename
-        (dolist (doc docs)
-          (write-texinfo doc)))
-      filename)))
diff --git a/third_party/lisp/alexandria/features.lisp b/third_party/lisp/alexandria/features.lisp
deleted file mode 100644
index 67348dbba43b..000000000000
--- a/third_party/lisp/alexandria/features.lisp
+++ /dev/null
@@ -1,14 +0,0 @@
-(in-package :alexandria)
-
-(defun featurep (feature-expression)
-  "Returns T if the argument matches the state of the *FEATURES*
-list and NIL if it does not. FEATURE-EXPRESSION can be any atom
-or list acceptable to the reader macros #+ and #-."
-  (etypecase feature-expression
-    (symbol (not (null (member feature-expression *features*))))
-    (cons (check-type (first feature-expression) symbol)
-          (eswitch ((first feature-expression) :test 'string=)
-            (:and (every #'featurep (rest feature-expression)))
-            (:or  (some #'featurep (rest feature-expression)))
-            (:not (assert (= 2 (length feature-expression)))
-                  (not (featurep (second feature-expression))))))))
diff --git a/third_party/lisp/alexandria/functions.lisp b/third_party/lisp/alexandria/functions.lisp
deleted file mode 100644
index dd83e38b4ebc..000000000000
--- a/third_party/lisp/alexandria/functions.lisp
+++ /dev/null
@@ -1,161 +0,0 @@
-(in-package :alexandria)
-
-;;; To propagate return type and allow the compiler to eliminate the IF when
-;;; it is known if the argument is function or not.
-(declaim (inline ensure-function))
-
-(declaim (ftype (function (t) (values function &optional))
-                ensure-function))
-(defun ensure-function (function-designator)
-  "Returns the function designated by FUNCTION-DESIGNATOR:
-if FUNCTION-DESIGNATOR is a function, it is returned, otherwise
-it must be a function name and its FDEFINITION is returned."
-  (if (functionp function-designator)
-      function-designator
-      (fdefinition function-designator)))
-
-(define-modify-macro ensure-functionf/1 () ensure-function)
-
-(defmacro ensure-functionf (&rest places)
-  "Multiple-place modify macro for ENSURE-FUNCTION: ensures that each of
-PLACES contains a function."
-  `(progn ,@(mapcar (lambda (x) `(ensure-functionf/1 ,x)) places)))
-
-(defun disjoin (predicate &rest more-predicates)
-  "Returns a function that applies each of PREDICATE and MORE-PREDICATE
-functions in turn to its arguments, returning the primary value of the first
-predicate that returns true, without calling the remaining predicates.
-If none of the predicates returns true, NIL is returned."
-  (declare (optimize (speed 3) (safety 1) (debug 1)))
-  (let ((predicate (ensure-function predicate))
-	(more-predicates (mapcar #'ensure-function more-predicates)))
-    (lambda (&rest arguments)
-      (or (apply predicate arguments)
-	  (some (lambda (p)
-		  (declare (type function p))
-		  (apply p arguments))
-		more-predicates)))))
-
-(defun conjoin (predicate &rest more-predicates)
-  "Returns a function that applies each of PREDICATE and MORE-PREDICATE
-functions in turn to its arguments, returning NIL if any of the predicates
-returns false, without calling the remaining predicates. If none of the
-predicates returns false, returns the primary value of the last predicate."
-  (if (null more-predicates)
-      predicate
-      (lambda (&rest arguments)
-	(and (apply predicate arguments)
-	     ;; Cannot simply use CL:EVERY because we want to return the
-	     ;; non-NIL value of the last predicate if all succeed.
-	     (do ((tail (cdr more-predicates) (cdr tail))
-		  (head (car more-predicates) (car tail)))
-		 ((not tail)
-		  (apply head arguments))
-	       (unless (apply head arguments)
-		 (return nil)))))))
-
-
-(defun compose (function &rest more-functions)
-  "Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies its
-arguments to to each in turn, starting from the rightmost of MORE-FUNCTIONS,
-and then calling the next one with the primary value of the last."
-  (declare (optimize (speed 3) (safety 1) (debug 1)))
-  (reduce (lambda (f g)
-	    (let ((f (ensure-function f))
-		  (g (ensure-function g)))
-	      (lambda (&rest arguments)
-		(declare (dynamic-extent arguments))
-		(funcall f (apply g arguments)))))
-          more-functions
-          :initial-value function))
-
-(define-compiler-macro compose (function &rest more-functions)
-  (labels ((compose-1 (funs)
-             (if (cdr funs)
-                 `(funcall ,(car funs) ,(compose-1 (cdr funs)))
-                 `(apply ,(car funs) arguments))))
-    (let* ((args (cons function more-functions))
-           (funs (make-gensym-list (length args) "COMPOSE")))
-      `(let ,(loop for f in funs for arg in args
-		   collect `(,f (ensure-function ,arg)))
-         (declare (optimize (speed 3) (safety 1) (debug 1)))
-         (lambda (&rest arguments)
-           (declare (dynamic-extent arguments))
-           ,(compose-1 funs))))))
-
-(defun multiple-value-compose (function &rest more-functions)
-    "Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies
-its arguments to each in turn, starting from the rightmost of
-MORE-FUNCTIONS, and then calling the next one with all the return values of
-the last."
-  (declare (optimize (speed 3) (safety 1) (debug 1)))
-  (reduce (lambda (f g)
-	    (let ((f (ensure-function f))
-		  (g (ensure-function g)))
-	      (lambda (&rest arguments)
-		(declare (dynamic-extent arguments))
-		(multiple-value-call f (apply g arguments)))))
-          more-functions
-          :initial-value function))
-
-(define-compiler-macro multiple-value-compose (function &rest more-functions)
-  (labels ((compose-1 (funs)
-             (if (cdr funs)
-                 `(multiple-value-call ,(car funs) ,(compose-1 (cdr funs)))
-                 `(apply ,(car funs) arguments))))
-    (let* ((args (cons function more-functions))
-           (funs (make-gensym-list (length args) "MV-COMPOSE")))
-      `(let ,(mapcar #'list funs args)
-         (declare (optimize (speed 3) (safety 1) (debug 1)))
-         (lambda (&rest arguments)
-           (declare (dynamic-extent arguments))
-           ,(compose-1 funs))))))
-
-(declaim (inline curry rcurry))
-
-(defun curry (function &rest arguments)
-  "Returns a function that applies ARGUMENTS and the arguments
-it is called with to FUNCTION."
-  (declare (optimize (speed 3) (safety 1)))
-  (let ((fn (ensure-function function)))
-    (lambda (&rest more)
-      (declare (dynamic-extent more))
-      ;; Using M-V-C we don't need to append the arguments.
-      (multiple-value-call fn (values-list arguments) (values-list more)))))
-
-(define-compiler-macro curry (function &rest arguments)
-  (let ((curries (make-gensym-list (length arguments) "CURRY"))
-        (fun (gensym "FUN")))
-    `(let ((,fun (ensure-function ,function))
-           ,@(mapcar #'list curries arguments))
-       (declare (optimize (speed 3) (safety 1)))
-       (lambda (&rest more)
-         (declare (dynamic-extent more))
-         (apply ,fun ,@curries more)))))
-
-(defun rcurry (function &rest arguments)
-  "Returns a function that applies the arguments it is called
-with and ARGUMENTS to FUNCTION."
-  (declare (optimize (speed 3) (safety 1)))
-  (let ((fn (ensure-function function)))
-    (lambda (&rest more)
-      (declare (dynamic-extent more))
-      (multiple-value-call fn (values-list more) (values-list arguments)))))
-
-(define-compiler-macro rcurry (function &rest arguments)
-  (let ((rcurries (make-gensym-list (length arguments) "RCURRY"))
-        (fun (gensym "FUN")))
-    `(let ((,fun (ensure-function ,function))
-           ,@(mapcar #'list rcurries arguments))
-       (declare (optimize (speed 3) (safety 1)))
-       (lambda (&rest more)
-         (declare (dynamic-extent more))
-         (multiple-value-call ,fun (values-list more) ,@rcurries)))))
-
-(declaim (notinline curry rcurry))
-
-(defmacro named-lambda (name lambda-list &body body)
-  "Expands into a lambda-expression within whose BODY NAME denotes the
-corresponding function."
-  `(labels ((,name ,lambda-list ,@body))
-     #',name))
diff --git a/third_party/lisp/alexandria/hash-tables.lisp b/third_party/lisp/alexandria/hash-tables.lisp
deleted file mode 100644
index a9f790220405..000000000000
--- a/third_party/lisp/alexandria/hash-tables.lisp
+++ /dev/null
@@ -1,101 +0,0 @@
-(in-package :alexandria)
-
-(defmacro ensure-gethash (key hash-table &optional default)
-  "Like GETHASH, but if KEY is not found in the HASH-TABLE saves the DEFAULT
-under key before returning it. Secondary return value is true if key was
-already in the table."
-  (once-only (key hash-table)
-    (with-unique-names (value presentp)
-      `(multiple-value-bind (,value ,presentp) (gethash ,key ,hash-table)
-         (if ,presentp
-             (values ,value ,presentp)
-             (values (setf (gethash ,key ,hash-table) ,default) nil))))))
-
-(defun copy-hash-table (table &key key test size
-                                   rehash-size rehash-threshold)
-  "Returns a copy of hash table TABLE, with the same keys and values
-as the TABLE. The copy has the same properties as the original, unless
-overridden by the keyword arguments.
-
-Before each of the original values is set into the new hash-table, KEY
-is invoked on the value. As KEY defaults to CL:IDENTITY, a shallow
-copy is returned by default."
-  (setf key (or key 'identity))
-  (setf test (or test (hash-table-test table)))
-  (setf size (or size (hash-table-size table)))
-  (setf rehash-size (or rehash-size (hash-table-rehash-size table)))
-  (setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table)))
-  (let ((copy (make-hash-table :test test :size size
-                               :rehash-size rehash-size
-                               :rehash-threshold rehash-threshold)))
-    (maphash (lambda (k v)
-               (setf (gethash k copy) (funcall key v)))
-             table)
-    copy))
-
-(declaim (inline maphash-keys))
-(defun maphash-keys (function table)
-  "Like MAPHASH, but calls FUNCTION with each key in the hash table TABLE."
-  (maphash (lambda (k v)
-             (declare (ignore v))
-             (funcall function k))
-           table))
-
-(declaim (inline maphash-values))
-(defun maphash-values (function table)
-  "Like MAPHASH, but calls FUNCTION with each value in the hash table TABLE."
-  (maphash (lambda (k v)
-             (declare (ignore k))
-             (funcall function v))
-           table))
-
-(defun hash-table-keys (table)
-  "Returns a list containing the keys of hash table TABLE."
-  (let ((keys nil))
-    (maphash-keys (lambda (k)
-                    (push k keys))
-                  table)
-    keys))
-
-(defun hash-table-values (table)
-  "Returns a list containing the values of hash table TABLE."
-  (let ((values nil))
-    (maphash-values (lambda (v)
-                      (push v values))
-                    table)
-    values))
-
-(defun hash-table-alist (table)
-  "Returns an association list containing the keys and values of hash table
-TABLE."
-  (let ((alist nil))
-    (maphash (lambda (k v)
-               (push (cons k v) alist))
-             table)
-    alist))
-
-(defun hash-table-plist (table)
-  "Returns a property list containing the keys and values of hash table
-TABLE."
-  (let ((plist nil))
-    (maphash (lambda (k v)
-               (setf plist (list* k v plist)))
-             table)
-    plist))
-
-(defun alist-hash-table (alist &rest hash-table-initargs)
-  "Returns a hash table containing the keys and values of the association list
-ALIST. Hash table is initialized using the HASH-TABLE-INITARGS."
-  (let ((table (apply #'make-hash-table hash-table-initargs)))
-    (dolist (cons alist)
-      (ensure-gethash (car cons) table (cdr cons)))
-    table))
-
-(defun plist-hash-table (plist &rest hash-table-initargs)
-  "Returns a hash table containing the keys and values of the property list
-PLIST. Hash table is initialized using the HASH-TABLE-INITARGS."
-  (let ((table (apply #'make-hash-table hash-table-initargs)))
-    (do ((tail plist (cddr tail)))
-        ((not tail))
-      (ensure-gethash (car tail) table (cadr tail)))
-    table))
diff --git a/third_party/lisp/alexandria/io.lisp b/third_party/lisp/alexandria/io.lisp
deleted file mode 100644
index 28bf5e6d82c7..000000000000
--- a/third_party/lisp/alexandria/io.lisp
+++ /dev/null
@@ -1,172 +0,0 @@
-;; Copyright (c) 2002-2006, Edward Marco Baringer
-;; All rights reserved.
-
-(in-package :alexandria)
-
-(defmacro with-open-file* ((stream filespec &key direction element-type
-                                   if-exists if-does-not-exist external-format)
-                           &body body)
-  "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments mean to use
-the default value specified for OPEN."
-  (once-only (direction element-type if-exists if-does-not-exist external-format)
-    `(with-open-stream
-         (,stream (apply #'open ,filespec
-                         (append
-                          (when ,direction
-                            (list :direction ,direction))
-                          (when ,element-type
-                            (list :element-type ,element-type))
-                          (when ,if-exists
-                            (list :if-exists ,if-exists))
-                          (when ,if-does-not-exist
-                            (list :if-does-not-exist ,if-does-not-exist))
-                          (when ,external-format
-                            (list :external-format ,external-format)))))
-       ,@body)))
-
-(defmacro with-input-from-file ((stream-name file-name &rest args
-                                             &key (direction nil direction-p)
-                                             &allow-other-keys)
-                                &body body)
-  "Evaluate BODY with STREAM-NAME to an input stream on the file
-FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
-which is only sent to WITH-OPEN-FILE when it's not NIL."
-  (declare (ignore direction))
-  (when direction-p
-    (error "Can't specify :DIRECTION for WITH-INPUT-FROM-FILE."))
-  `(with-open-file* (,stream-name ,file-name :direction :input ,@args)
-     ,@body))
-
-(defmacro with-output-to-file ((stream-name file-name &rest args
-                                            &key (direction nil direction-p)
-                                            &allow-other-keys)
-			       &body body)
-  "Evaluate BODY with STREAM-NAME to an output stream on the file
-FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
-which is only sent to WITH-OPEN-FILE when it's not NIL."
-  (declare (ignore direction))
-  (when direction-p
-    (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE."))
-  `(with-open-file* (,stream-name ,file-name :direction :output ,@args)
-     ,@body))
-
-(defun read-stream-content-into-string (stream &key (buffer-size 4096))
-  "Return the \"content\" of STREAM as a fresh string."
-  (check-type buffer-size positive-integer)
-  (let ((*print-pretty* nil))
-    (with-output-to-string (datum)
-      (let ((buffer (make-array buffer-size :element-type 'character)))
-        (loop
-          :for bytes-read = (read-sequence buffer stream)
-          :do (write-sequence buffer datum :start 0 :end bytes-read)
-          :while (= bytes-read buffer-size))))))
-
-(defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
-  "Return the contents of the file denoted by PATHNAME as a fresh string.
-
-The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
-unless it's NIL, which means the system default."
-  (with-input-from-file
-      (file-stream pathname :external-format external-format)
-    (read-stream-content-into-string file-stream :buffer-size buffer-size)))
-
-(defun write-string-into-file (string pathname &key (if-exists :error)
-                                                    if-does-not-exist
-                                                    external-format)
-  "Write STRING to PATHNAME.
-
-The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
-unless it's NIL, which means the system default."
-  (with-output-to-file (file-stream pathname :if-exists if-exists
-                                    :if-does-not-exist if-does-not-exist
-                                    :external-format external-format)
-    (write-sequence string file-stream)))
-
-(defun read-stream-content-into-byte-vector (stream &key ((%length length))
-                                                         (initial-size 4096))
-  "Return \"content\" of STREAM as freshly allocated (unsigned-byte 8) vector."
-  (check-type length (or null non-negative-integer))
-  (check-type initial-size positive-integer)
-  (do ((buffer (make-array (or length initial-size)
-                           :element-type '(unsigned-byte 8)))
-       (offset 0)
-       (offset-wanted 0))
-      ((or (/= offset-wanted offset)
-           (and length (>= offset length)))
-       (if (= offset (length buffer))
-           buffer
-           (subseq buffer 0 offset)))
-    (unless (zerop offset)
-      (let ((new-buffer (make-array (* 2 (length buffer))
-                                    :element-type '(unsigned-byte 8))))
-        (replace new-buffer buffer)
-        (setf buffer new-buffer)))
-    (setf offset-wanted (length buffer)
-          offset (read-sequence buffer stream :start offset))))
-
-(defun read-file-into-byte-vector (pathname)
-  "Read PATHNAME into a freshly allocated (unsigned-byte 8) vector."
-  (with-input-from-file (stream pathname :element-type '(unsigned-byte 8))
-    (read-stream-content-into-byte-vector stream '%length (file-length stream))))
-
-(defun write-byte-vector-into-file (bytes pathname &key (if-exists :error)
-                                                       if-does-not-exist)
-  "Write BYTES to PATHNAME."
-  (check-type bytes (vector (unsigned-byte 8)))
-  (with-output-to-file (stream pathname :if-exists if-exists
-                               :if-does-not-exist if-does-not-exist
-                               :element-type '(unsigned-byte 8))
-    (write-sequence bytes stream)))
-
-(defun copy-file (from to &key (if-to-exists :supersede)
-			       (element-type '(unsigned-byte 8)) finish-output)
-  (with-input-from-file (input from :element-type element-type)
-    (with-output-to-file (output to :element-type element-type
-				    :if-exists if-to-exists)
-      (copy-stream input output
-                   :element-type element-type
-                   :finish-output finish-output))))
-
-(defun copy-stream (input output &key (element-type (stream-element-type input))
-                    (buffer-size 4096)
-                    (buffer (make-array buffer-size :element-type element-type))
-                    (start 0) end
-                    finish-output)
-  "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT must
-be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and must have
-compatible element-types."
-  (check-type start non-negative-integer)
-  (check-type end (or null non-negative-integer))
-  (check-type buffer-size positive-integer)
-  (when (and end
-             (< end start))
-    (error "END is smaller than START in ~S" 'copy-stream))
-  (let ((output-position 0)
-        (input-position 0))
-    (unless (zerop start)
-      ;; FIXME add platform specific optimization to skip seekable streams
-      (loop while (< input-position start)
-            do (let ((n (read-sequence buffer input
-                                       :end (min (length buffer)
-                                                 (- start input-position)))))
-                 (when (zerop n)
-                   (error "~@<Could not read enough bytes from the input to fulfill ~
-                           the :START ~S requirement in ~S.~:@>" 'copy-stream start))
-                 (incf input-position n))))
-    (assert (= input-position start))
-    (loop while (or (null end) (< input-position end))
-          do (let ((n (read-sequence buffer input
-                                     :end (when end
-                                            (min (length buffer)
-                                                 (- end input-position))))))
-               (when (zerop n)
-                 (if end
-                     (error "~@<Could not read enough bytes from the input to fulfill ~
-                          the :END ~S requirement in ~S.~:@>" 'copy-stream end)
-                     (return)))
-               (incf input-position n)
-               (write-sequence buffer output :end n)
-               (incf output-position n)))
-    (when finish-output
-      (finish-output output))
-    output-position))
diff --git a/third_party/lisp/alexandria/lists.lisp b/third_party/lisp/alexandria/lists.lisp
deleted file mode 100644
index 51286071ebf2..000000000000
--- a/third_party/lisp/alexandria/lists.lisp
+++ /dev/null
@@ -1,367 +0,0 @@
-(in-package :alexandria)
-
-(declaim (inline safe-endp))
-(defun safe-endp (x)
-  (declare (optimize safety))
-  (endp x))
-
-(defun alist-plist (alist)
-  "Returns a property list containing the same keys and values as the
-association list ALIST in the same order."
-  (let (plist)
-    (dolist (pair alist)
-      (push (car pair) plist)
-      (push (cdr pair) plist))
-    (nreverse plist)))
-
-(defun plist-alist (plist)
-  "Returns an association list containing the same keys and values as the
-property list PLIST in the same order."
-  (let (alist)
-    (do ((tail plist (cddr tail)))
-        ((safe-endp tail) (nreverse alist))
-      (push (cons (car tail) (cadr tail)) alist))))
-
-(declaim (inline racons))
-(defun racons (key value ralist)
-  (acons value key ralist))
-
-(macrolet
-    ((define-alist-get (name get-entry get-value-from-entry add doc)
-       `(progn
-          (declaim (inline ,name))
-          (defun ,name (alist key &key (test 'eql))
-            ,doc
-            (let ((entry (,get-entry key alist :test test)))
-              (values (,get-value-from-entry entry) entry)))
-          (define-setf-expander ,name (place key &key (test ''eql)
-                                       &environment env)
-            (multiple-value-bind
-                  (temporary-variables initforms newvals setter getter)
-                (get-setf-expansion place env)
-              (when (cdr newvals)
-                (error "~A cannot store multiple values in one place" ',name))
-              (with-unique-names (new-value key-val test-val alist entry)
-                (values
-                 (append temporary-variables
-                         (list alist
-                               key-val
-                               test-val
-                               entry))
-                 (append initforms
-                         (list getter
-                               key
-                               test
-                               `(,',get-entry ,key-val ,alist :test ,test-val)))
-                 `(,new-value)
-                 `(cond
-                    (,entry
-                     (setf (,',get-value-from-entry ,entry) ,new-value))
-                    (t
-                     (let ,newvals
-                       (setf ,(first newvals) (,',add ,key ,new-value ,alist))
-                       ,setter
-                       ,new-value)))
-                 `(,',get-value-from-entry ,entry))))))))
- (define-alist-get assoc-value assoc cdr acons
-"ASSOC-VALUE is an alist accessor very much like ASSOC, but it can
-be used with SETF.")
- (define-alist-get rassoc-value rassoc car racons
-"RASSOC-VALUE is an alist accessor very much like RASSOC, but it can
-be used with SETF."))
-
-(defun malformed-plist (plist)
-  (error "Malformed plist: ~S" plist))
-
-(defmacro doplist ((key val plist &optional values) &body body)
-  "Iterates over elements of PLIST. BODY can be preceded by
-declarations, and is like a TAGBODY. RETURN may be used to terminate
-the iteration early. If RETURN is not used, returns VALUES."
-  (multiple-value-bind (forms declarations) (parse-body body)
-    (with-gensyms (tail loop results)
-      `(block nil
-         (flet ((,results ()
-                  (let (,key ,val)
-                    (declare (ignorable ,key ,val))
-                    (return ,values))))
-           (let* ((,tail ,plist)
-                  (,key (if ,tail
-                            (pop ,tail)
-                            (,results)))
-                 (,val (if ,tail
-                           (pop ,tail)
-                           (malformed-plist ',plist))))
-            (declare (ignorable ,key ,val))
-            ,@declarations
-            (tagbody
-               ,loop
-               ,@forms
-               (setf ,key (if ,tail
-                              (pop ,tail)
-                              (,results))
-                     ,val (if ,tail
-                              (pop ,tail)
-                              (malformed-plist ',plist)))
-               (go ,loop))))))))
-
-(define-modify-macro appendf (&rest lists) append
-  "Modify-macro for APPEND. Appends LISTS to the place designated by the first
-argument.")
-
-(define-modify-macro nconcf (&rest lists) nconc
-  "Modify-macro for NCONC. Concatenates LISTS to place designated by the first
-argument.")
-
-(define-modify-macro unionf (list &rest args) union
-  "Modify-macro for UNION. Saves the union of LIST and the contents of the
-place designated by the first argument to the designated place.")
-
-(define-modify-macro nunionf (list &rest args) nunion
-  "Modify-macro for NUNION. Saves the union of LIST and the contents of the
-place designated by the first argument to the designated place. May modify
-either argument.")
-
-(define-modify-macro reversef () reverse
-  "Modify-macro for REVERSE. Copies and reverses the list stored in the given
-place and saves back the result into the place.")
-
-(define-modify-macro nreversef () nreverse
-  "Modify-macro for NREVERSE. Reverses the list stored in the given place by
-destructively modifying it and saves back the result into the place.")
-
-(defun circular-list (&rest elements)
-  "Creates a circular list of ELEMENTS."
-  (let ((cycle (copy-list elements)))
-    (nconc cycle cycle)))
-
-(defun circular-list-p (object)
-  "Returns true if OBJECT is a circular list, NIL otherwise."
-  (and (listp object)
-       (do ((fast object (cddr fast))
-            (slow (cons (car object) (cdr object)) (cdr slow)))
-           (nil)
-         (unless (and (consp fast) (listp (cdr fast)))
-           (return nil))
-         (when (eq fast slow)
-           (return t)))))
-
-(defun circular-tree-p (object)
-  "Returns true if OBJECT is a circular tree, NIL otherwise."
-  (labels ((circularp (object seen)
-             (and (consp object)
-                  (do ((fast (cons (car object) (cdr object)) (cddr fast))
-                       (slow object (cdr slow)))
-                      (nil)
-                    (when (or (eq fast slow) (member slow seen))
-                      (return-from circular-tree-p t))
-                    (when (or (not (consp fast)) (not (consp (cdr slow))))
-                      (return
-                        (do ((tail object (cdr tail)))
-                            ((not (consp tail))
-                             nil)
-                          (let ((elt (car tail)))
-                            (circularp elt (cons object seen))))))))))
-    (circularp object nil)))
-
-(defun proper-list-p (object)
-  "Returns true if OBJECT is a proper list."
-  (cond ((not object)
-         t)
-        ((consp object)
-         (do ((fast object (cddr fast))
-              (slow (cons (car object) (cdr object)) (cdr slow)))
-             (nil)
-           (unless (and (listp fast) (consp (cdr fast)))
-             (return (and (listp fast) (not (cdr fast)))))
-           (when (eq fast slow)
-             (return nil))))
-        (t
-         nil)))
-
-(deftype proper-list ()
-  "Type designator for proper lists. Implemented as a SATISFIES type, hence
-not recommended for performance intensive use. Main usefullness as a type
-designator of the expected type in a TYPE-ERROR."
-  `(and list (satisfies proper-list-p)))
-
-(defun circular-list-error (list)
-  (error 'type-error
-         :datum list
-         :expected-type '(and list (not circular-list))))
-
-(macrolet ((def (name lambda-list doc step declare ret1 ret2)
-             (assert (member 'list lambda-list))
-             `(defun ,name ,lambda-list
-                ,doc
-                (do ((last list fast)
-                     (fast list (cddr fast))
-                     (slow (cons (car list) (cdr list)) (cdr slow))
-                     ,@(when step (list step)))
-                    (nil)
-                  (declare (dynamic-extent slow) ,@(when declare (list declare))
-                           (ignorable last))
-                  (when (safe-endp fast)
-                    (return ,ret1))
-                  (when (safe-endp (cdr fast))
-                    (return ,ret2))
-                  (when (eq fast slow)
-                    (circular-list-error list))))))
-  (def proper-list-length (list)
-    "Returns length of LIST, signalling an error if it is not a proper list."
-    (n 1 (+ n 2))
-    ;; KLUDGE: Most implementations don't actually support lists with bignum
-    ;; elements -- and this is WAY faster on most implementations then declaring
-    ;; N to be an UNSIGNED-BYTE.
-    (fixnum n)
-    (1- n)
-    n)
-
-  (def lastcar (list)
-      "Returns the last element of LIST. Signals a type-error if LIST is not a
-proper list."
-    nil
-    nil
-    (cadr last)
-    (car fast))
-
-  (def (setf lastcar) (object list)
-      "Sets the last element of LIST. Signals a type-error if LIST is not a proper
-list."
-    nil
-    nil
-    (setf (cadr last) object)
-    (setf (car fast) object)))
-
-(defun make-circular-list (length &key initial-element)
-  "Creates a circular list of LENGTH with the given INITIAL-ELEMENT."
-  (let ((cycle (make-list length :initial-element initial-element)))
-    (nconc cycle cycle)))
-
-(deftype circular-list ()
-  "Type designator for circular lists. Implemented as a SATISFIES type, so not
-recommended for performance intensive use. Main usefullness as the
-expected-type designator of a TYPE-ERROR."
-  `(satisfies circular-list-p))
-
-(defun ensure-car (thing)
-  "If THING is a CONS, its CAR is returned. Otherwise THING is returned."
-  (if (consp thing)
-      (car thing)
-      thing))
-
-(defun ensure-cons (cons)
-  "If CONS is a cons, it is returned. Otherwise returns a fresh cons with CONS
-  in the car, and NIL in the cdr."
-  (if (consp cons)
-      cons
-      (cons cons nil)))
-
-(defun ensure-list (list)
-  "If LIST is a list, it is returned. Otherwise returns the list designated by LIST."
-  (if (listp list)
-      list
-      (list list)))
-
-(defun remove-from-plist (plist &rest keys)
-  "Returns a propery-list with same keys and values as PLIST, except that keys
-in the list designated by KEYS and values corresponding to them are removed.
-The returned property-list may share structure with the PLIST, but PLIST is
-not destructively modified. Keys are compared using EQ."
-  (declare (optimize (speed 3)))
-  ;; FIXME: possible optimization: (remove-from-plist '(:x 0 :a 1 :b 2) :a)
-  ;; could return the tail without consing up a new list.
-  (loop for (key . rest) on plist by #'cddr
-        do (assert rest () "Expected a proper plist, got ~S" plist)
-        unless (member key keys :test #'eq)
-        collect key and collect (first rest)))
-
-(defun delete-from-plist (plist &rest keys)
-  "Just like REMOVE-FROM-PLIST, but this version may destructively modify the
-provided PLIST."
-  (declare (optimize speed))
-  (loop with head = plist
-        with tail = nil   ; a nil tail means an empty result so far
-        for (key . rest) on plist by #'cddr
-        do (assert rest () "Expected a proper plist, got ~S" plist)
-           (if (member key keys :test #'eq)
-               ;; skip over this pair
-               (let ((next (cdr rest)))
-                 (if tail
-                     (setf (cdr tail) next)
-                     (setf head next)))
-               ;; keep this pair
-               (setf tail rest))
-        finally (return head)))
-
-(define-modify-macro remove-from-plistf (&rest keys) remove-from-plist
-                     "Modify macro for REMOVE-FROM-PLIST.")
-(define-modify-macro delete-from-plistf (&rest keys) delete-from-plist
-                     "Modify macro for DELETE-FROM-PLIST.")
-
-(declaim (inline sans))
-(defun sans (plist &rest keys)
-  "Alias of REMOVE-FROM-PLIST for backward compatibility."
-  (apply #'remove-from-plist plist keys))
-
-(defun mappend (function &rest lists)
-  "Applies FUNCTION to respective element(s) of each LIST, appending all the
-all the result list to a single list. FUNCTION must return a list."
-  (loop for results in (apply #'mapcar function lists)
-        append results))
-
-(defun setp (object &key (test #'eql) (key #'identity))
-  "Returns true if OBJECT is a list that denotes a set, NIL otherwise. A list
-denotes a set if each element of the list is unique under KEY and TEST."
-  (and (listp object)
-       (let (seen)
-         (dolist (elt object t)
-           (let ((key (funcall key elt)))
-             (if (member key seen :test test)
-                 (return nil)
-                 (push key seen)))))))
-
-(defun set-equal (list1 list2 &key (test #'eql) (key nil keyp))
-  "Returns true if every element of LIST1 matches some element of LIST2 and
-every element of LIST2 matches some element of LIST1. Otherwise returns false."
-  (let ((keylist1 (if keyp (mapcar key list1) list1))
-        (keylist2 (if keyp (mapcar key list2) list2)))
-    (and (dolist (elt keylist1 t)
-           (or (member elt keylist2 :test test)
-               (return nil)))
-         (dolist (elt keylist2 t)
-           (or (member elt keylist1 :test test)
-               (return nil))))))
-
-(defun map-product (function list &rest more-lists)
-  "Returns a list containing the results of calling FUNCTION with one argument
-from LIST, and one from each of MORE-LISTS for each combination of arguments.
-In other words, returns the product of LIST and MORE-LISTS using FUNCTION.
-
-Example:
-
- (map-product 'list '(1 2) '(3 4) '(5 6))
-  => ((1 3 5) (1 3 6) (1 4 5) (1 4 6)
-      (2 3 5) (2 3 6) (2 4 5) (2 4 6))
-"
-  (labels ((%map-product (f lists)
-             (let ((more (cdr lists))
-                   (one (car lists)))
-               (if (not more)
-                   (mapcar f one)
-                   (mappend (lambda (x)
-                              (%map-product (curry f x) more))
-                            one)))))
-    (%map-product (ensure-function function) (cons list more-lists))))
-
-(defun flatten (tree)
-  "Traverses the tree in order, collecting non-null leaves into a list."
-  (let (list)
-    (labels ((traverse (subtree)
-               (when subtree
-                 (if (consp subtree)
-                     (progn
-                       (traverse (car subtree))
-                       (traverse (cdr subtree)))
-                     (push subtree list)))))
-      (traverse tree))
-    (nreverse list)))
diff --git a/third_party/lisp/alexandria/macros.lisp b/third_party/lisp/alexandria/macros.lisp
deleted file mode 100644
index 4364ad63b82a..000000000000
--- a/third_party/lisp/alexandria/macros.lisp
+++ /dev/null
@@ -1,370 +0,0 @@
-(in-package :alexandria)
-
-(defmacro with-gensyms (names &body forms)
-  "Binds a set of variables to gensyms and evaluates the implicit progn FORMS.
-
-Each element within NAMES is either a symbol SYMBOL or a pair (SYMBOL
-STRING-DESIGNATOR). Bare symbols are equivalent to the pair (SYMBOL SYMBOL).
-
-Each pair (SYMBOL STRING-DESIGNATOR) specifies that the variable named by SYMBOL
-should be bound to a symbol constructed using GENSYM with the string designated
-by STRING-DESIGNATOR being its first argument."
-  `(let ,(mapcar (lambda (name)
-                   (multiple-value-bind (symbol string)
-                       (etypecase name
-                         (symbol
-                          (values name (symbol-name name)))
-                         ((cons symbol (cons string-designator null))
-                          (values (first name) (string (second name)))))
-                     `(,symbol (gensym ,string))))
-                 names)
-     ,@forms))
-
-(defmacro with-unique-names (names &body forms)
-  "Alias for WITH-GENSYMS."
-  `(with-gensyms ,names ,@forms))
-
-(defmacro once-only (specs &body forms)
-  "Constructs code whose primary goal is to help automate the handling of
-multiple evaluation within macros. Multiple evaluation is handled by introducing
-intermediate variables, in order to reuse the result of an expression.
-
-The returned value is a list of the form
-
-  (let ((<gensym-1> <expr-1>)
-        ...
-        (<gensym-n> <expr-n>))
-    <res>)
-
-where GENSYM-1, ..., GENSYM-N are the intermediate variables introduced in order
-to evaluate EXPR-1, ..., EXPR-N once, only. RES is code that is the result of
-evaluating the implicit progn FORMS within a special context determined by
-SPECS. RES should make use of (reference) the intermediate variables.
-
-Each element within SPECS is either a symbol SYMBOL or a pair (SYMBOL INITFORM).
-Bare symbols are equivalent to the pair (SYMBOL SYMBOL).
-
-Each pair (SYMBOL INITFORM) specifies a single intermediate variable:
-
-- INITFORM is an expression evaluated to produce EXPR-i
-
-- SYMBOL is the name of the variable that will be bound around FORMS to the
-  corresponding gensym GENSYM-i, in order for FORMS to generate RES that
-  references the intermediate variable
-
-The evaluation of INITFORMs and binding of SYMBOLs resembles LET. INITFORMs of
-all the pairs are evaluated before binding SYMBOLs and evaluating FORMS.
-
-Example:
-
-  The following expression
-
-  (let ((x '(incf y)))
-    (once-only (x)
-      `(cons ,x ,x)))
-
-  ;;; =>
-  ;;; (let ((#1=#:X123 (incf y)))
-  ;;;   (cons #1# #1#))
-
-  could be used within a macro to avoid multiple evaluation like so
-
-  (defmacro cons1 (x)
-    (once-only (x)
-      `(cons ,x ,x)))
-
-  (let ((y 0))
-    (cons1 (incf y)))
-
-  ;;; => (1 . 1)
-
-Example:
-
-  The following expression demonstrates the usage of the INITFORM field
-
-  (let ((expr '(incf y)))
-    (once-only ((var `(1+ ,expr)))
-      `(list ',expr ,var ,var)))
-
-  ;;; =>
-  ;;; (let ((#1=#:VAR123 (1+ (incf y))))
-  ;;;   (list '(incf y) #1# #1))
-
-  which could be used like so
-
-  (defmacro print-succ-twice (expr)
-    (once-only ((var `(1+ ,expr)))
-      `(format t \"Expr: ~s, Once: ~s, Twice: ~s~%\" ',expr ,var ,var)))
-
-  (let ((y 10))
-    (print-succ-twice (incf y)))
-
-  ;;; >>
-  ;;; Expr: (INCF Y), Once: 12, Twice: 12"
-  (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
-        (names-and-forms (mapcar (lambda (spec)
-                                   (etypecase spec
-                                     (list
-                                      (destructuring-bind (name form) spec
-                                        (cons name form)))
-                                     (symbol
-                                      (cons spec spec))))
-                                 specs)))
-    ;; bind in user-macro
-    `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
-                   gensyms names-and-forms)
-       ;; bind in final expansion
-       `(let (,,@(mapcar (lambda (g n)
-                           ``(,,g ,,(cdr n)))
-                         gensyms names-and-forms))
-          ;; bind in user-macro
-          ,(let ,(mapcar (lambda (n g) (list (car n) g))
-                         names-and-forms gensyms)
-             ,@forms)))))
-
-(defun parse-body (body &key documentation whole)
-  "Parses BODY into (values remaining-forms declarations doc-string).
-Documentation strings are recognized only if DOCUMENTATION is true.
-Syntax errors in body are signalled and WHOLE is used in the signal
-arguments when given."
-  (let ((doc nil)
-        (decls nil)
-        (current nil))
-    (tagbody
-     :declarations
-       (setf current (car body))
-       (when (and documentation (stringp current) (cdr body))
-         (if doc
-             (error "Too many documentation strings in ~S." (or whole body))
-             (setf doc (pop body)))
-         (go :declarations))
-       (when (and (listp current) (eql (first current) 'declare))
-         (push (pop body) decls)
-         (go :declarations)))
-    (values body (nreverse decls) doc)))
-
-(defun parse-ordinary-lambda-list (lambda-list &key (normalize t)
-                                   allow-specializers
-                                   (normalize-optional normalize)
-                                   (normalize-keyword normalize)
-                                   (normalize-auxilary normalize))
-  "Parses an ordinary lambda-list, returning as multiple values:
-
-1. Required parameters.
-
-2. Optional parameter specifications, normalized into form:
-
-   (name init suppliedp)
-
-3. Name of the rest parameter, or NIL.
-
-4. Keyword parameter specifications, normalized into form:
-
-   ((keyword-name name) init suppliedp)
-
-5. Boolean indicating &ALLOW-OTHER-KEYS presence.
-
-6. &AUX parameter specifications, normalized into form
-
-   (name init).
-
-7. Existence of &KEY in the lambda-list.
-
-Signals a PROGRAM-ERROR is the lambda-list is malformed."
-  (let ((state :required)
-        (allow-other-keys nil)
-        (auxp nil)
-        (required nil)
-        (optional nil)
-        (rest nil)
-        (keys nil)
-        (keyp nil)
-        (aux nil))
-    (labels ((fail (elt)
-               (simple-program-error "Misplaced ~S in ordinary lambda-list:~%  ~S"
-                                     elt lambda-list))
-             (check-variable (elt what &optional (allow-specializers allow-specializers))
-               (unless (and (or (symbolp elt)
-                                (and allow-specializers
-                                     (consp elt) (= 2 (length elt)) (symbolp (first elt))))
-                            (not (constantp elt)))
-                 (simple-program-error "Invalid ~A ~S in ordinary lambda-list:~%  ~S"
-                                       what elt lambda-list)))
-             (check-spec (spec what)
-               (destructuring-bind (init suppliedp) spec
-                 (declare (ignore init))
-                 (check-variable suppliedp what nil))))
-      (dolist (elt lambda-list)
-        (case elt
-          (&optional
-           (if (eq state :required)
-               (setf state elt)
-               (fail elt)))
-          (&rest
-           (if (member state '(:required &optional))
-               (setf state elt)
-               (fail elt)))
-          (&key
-           (if (member state '(:required &optional :after-rest))
-               (setf state elt)
-               (fail elt))
-           (setf keyp t))
-          (&allow-other-keys
-           (if (eq state '&key)
-               (setf allow-other-keys t
-                     state elt)
-               (fail elt)))
-          (&aux
-           (cond ((eq state '&rest)
-                  (fail elt))
-                 (auxp
-                  (simple-program-error "Multiple ~S in ordinary lambda-list:~%  ~S"
-                                        elt lambda-list))
-                 (t
-                  (setf auxp t
-                        state elt))
-                 ))
-          (otherwise
-           (when (member elt '#.(set-difference lambda-list-keywords
-                                                '(&optional &rest &key &allow-other-keys &aux)))
-             (simple-program-error
-              "Bad lambda-list keyword ~S in ordinary lambda-list:~%  ~S"
-              elt lambda-list))
-           (case state
-             (:required
-              (check-variable elt "required parameter")
-              (push elt required))
-             (&optional
-              (cond ((consp elt)
-                     (destructuring-bind (name &rest tail) elt
-                       (check-variable name "optional parameter")
-                       (cond ((cdr tail)
-                              (check-spec tail "optional-supplied-p parameter"))
-                             ((and normalize-optional tail)
-                              (setf elt (append elt '(nil))))
-                             (normalize-optional
-                              (setf elt (append elt '(nil nil)))))))
-                    (t
-                     (check-variable elt "optional parameter")
-                     (when normalize-optional
-                       (setf elt (cons elt '(nil nil))))))
-              (push (ensure-list elt) optional))
-             (&rest
-              (check-variable elt "rest parameter")
-              (setf rest elt
-                    state :after-rest))
-             (&key
-              (cond ((consp elt)
-                     (destructuring-bind (var-or-kv &rest tail) elt
-                       (cond ((consp var-or-kv)
-                              (destructuring-bind (keyword var) var-or-kv
-                                (unless (symbolp keyword)
-                                  (simple-program-error "Invalid keyword name ~S in ordinary ~
-                                                         lambda-list:~%  ~S"
-                                                        keyword lambda-list))
-                                (check-variable var "keyword parameter")))
-                             (t
-                              (check-variable var-or-kv "keyword parameter")
-                              (when normalize-keyword
-                                (setf var-or-kv (list (make-keyword var-or-kv) var-or-kv)))))
-                       (cond ((cdr tail)
-                              (check-spec tail "keyword-supplied-p parameter"))
-                             ((and normalize-keyword tail)
-                              (setf tail (append tail '(nil))))
-                             (normalize-keyword
-                              (setf tail '(nil nil))))
-                       (setf elt (cons var-or-kv tail))))
-                    (t
-                     (check-variable elt "keyword parameter")
-                     (setf elt (if normalize-keyword
-                                   (list (list (make-keyword elt) elt) nil nil)
-                                   elt))))
-              (push elt keys))
-             (&aux
-              (if (consp elt)
-                  (destructuring-bind (var &optional init) elt
-                    (declare (ignore init))
-                    (check-variable var "&aux parameter"))
-                  (progn
-                    (check-variable elt "&aux parameter")
-                    (setf elt (list* elt (when normalize-auxilary
-                                           '(nil))))))
-              (push elt aux))
-             (t
-              (simple-program-error "Invalid ordinary lambda-list:~%  ~S" lambda-list)))))))
-    (values (nreverse required) (nreverse optional) rest (nreverse keys)
-            allow-other-keys (nreverse aux) keyp)))
-
-;;;; DESTRUCTURING-*CASE
-
-(defun expand-destructuring-case (key clauses case)
-  (once-only (key)
-    `(if (typep ,key 'cons)
-         (,case (car ,key)
-           ,@(mapcar (lambda (clause)
-                       (destructuring-bind ((keys . lambda-list) &body body) clause
-                         `(,keys
-                           (destructuring-bind ,lambda-list (cdr ,key)
-                             ,@body))))
-                     clauses))
-         (error "Invalid key to DESTRUCTURING-~S: ~S" ',case ,key))))
-
-(defmacro destructuring-case (keyform &body clauses)
-  "DESTRUCTURING-CASE, -CCASE, and -ECASE are a combination of CASE and DESTRUCTURING-BIND.
-KEYFORM must evaluate to a CONS.
-
-Clauses are of the form:
-
-  ((CASE-KEYS . DESTRUCTURING-LAMBDA-LIST) FORM*)
-
-The clause whose CASE-KEYS matches CAR of KEY, as if by CASE, CCASE, or ECASE,
-is selected, and FORMs are then executed with CDR of KEY is destructured and
-bound by the DESTRUCTURING-LAMBDA-LIST.
-
-Example:
-
- (defun dcase (x)
-   (destructuring-case x
-     ((:foo a b)
-      (format nil \"foo: ~S, ~S\" a b))
-     ((:bar &key a b)
-      (format nil \"bar: ~S, ~S\" a b))
-     (((:alt1 :alt2) a)
-      (format nil \"alt: ~S\" a))
-     ((t &rest rest)
-      (format nil \"unknown: ~S\" rest))))
-
-  (dcase (list :foo 1 2))        ; => \"foo: 1, 2\"
-  (dcase (list :bar :a 1 :b 2))  ; => \"bar: 1, 2\"
-  (dcase (list :alt1 1))         ; => \"alt: 1\"
-  (dcase (list :alt2 2))         ; => \"alt: 2\"
-  (dcase (list :quux 1 2 3))     ; => \"unknown: 1, 2, 3\"
-
- (defun decase (x)
-   (destructuring-case x
-     ((:foo a b)
-      (format nil \"foo: ~S, ~S\" a b))
-     ((:bar &key a b)
-      (format nil \"bar: ~S, ~S\" a b))
-     (((:alt1 :alt2) a)
-      (format nil \"alt: ~S\" a))))
-
-  (decase (list :foo 1 2))        ; => \"foo: 1, 2\"
-  (decase (list :bar :a 1 :b 2))  ; => \"bar: 1, 2\"
-  (decase (list :alt1 1))         ; => \"alt: 1\"
-  (decase (list :alt2 2))         ; => \"alt: 2\"
-  (decase (list :quux 1 2 3))     ; =| error
-"
-  (expand-destructuring-case keyform clauses 'case))
-
-(defmacro destructuring-ccase (keyform &body clauses)
-  (expand-destructuring-case keyform clauses 'ccase))
-
-(defmacro destructuring-ecase (keyform &body clauses)
-  (expand-destructuring-case keyform clauses 'ecase))
-
-(dolist (name '(destructuring-ccase destructuring-ecase))
-  (setf (documentation name 'function) (documentation 'destructuring-case 'function)))
-
-
-
diff --git a/third_party/lisp/alexandria/numbers.lisp b/third_party/lisp/alexandria/numbers.lisp
deleted file mode 100644
index 1c06f71d508f..000000000000
--- a/third_party/lisp/alexandria/numbers.lisp
+++ /dev/null
@@ -1,295 +0,0 @@
-(in-package :alexandria)
-
-(declaim (inline clamp))
-(defun clamp (number min max)
-  "Clamps the NUMBER into [min, max] range. Returns MIN if NUMBER is lesser then
-MIN and MAX if NUMBER is greater then MAX, otherwise returns NUMBER."
-  (if (< number min)
-      min
-      (if (> number max)
-          max
-          number)))
-
-(defun gaussian-random (&optional min max)
-  "Returns two gaussian random double floats as the primary and secondary value,
-optionally constrained by MIN and MAX. Gaussian random numbers form a standard
-normal distribution around 0.0d0.
-
-Sufficiently positive MIN or negative MAX will cause the algorithm used to
-take a very long time. If MIN is positive it should be close to zero, and
-similarly if MAX is negative it should be close to zero."
-  (macrolet
-      ((valid (x)
-         `(<= (or min ,x) ,x (or max ,x)) ))
-    (labels
-        ((gauss ()
-           (loop
-                 for x1 = (- (random 2.0d0) 1.0d0)
-                 for x2 = (- (random 2.0d0) 1.0d0)
-                 for w = (+ (expt x1 2) (expt x2 2))
-                 when (< w 1.0d0)
-                 do (let ((v (sqrt (/ (* -2.0d0 (log w)) w))))
-                      (return (values (* x1 v) (* x2 v))))))
-         (guard (x)
-           (unless (valid x)
-             (tagbody
-              :retry
-                (multiple-value-bind (x1 x2) (gauss)
-                  (when (valid x1)
-                    (setf x x1)
-                    (go :done))
-                  (when (valid x2)
-                    (setf x x2)
-                    (go :done))
-                  (go :retry))
-              :done))
-           x))
-      (multiple-value-bind
-            (g1 g2) (gauss)
-        (values (guard g1) (guard g2))))))
-
-(declaim (inline iota))
-(defun iota (n &key (start 0) (step 1))
-  "Return a list of n numbers, starting from START (with numeric contagion
-from STEP applied), each consequtive number being the sum of the previous one
-and STEP. START defaults to 0 and STEP to 1.
-
-Examples:
-
-  (iota 4)                      => (0 1 2 3)
-  (iota 3 :start 1 :step 1.0)   => (1.0 2.0 3.0)
-  (iota 3 :start -1 :step -1/2) => (-1 -3/2 -2)
-"
-  (declare (type (integer 0) n) (number start step))
-  (loop ;; KLUDGE: get numeric contagion right for the first element too
-        for i = (+ (- (+ start step) step)) then (+ i step)
-        repeat n
-        collect i))
-
-(declaim (inline map-iota))
-(defun map-iota (function n &key (start 0) (step 1))
-  "Calls FUNCTION with N numbers, starting from START (with numeric contagion
-from STEP applied), each consequtive number being the sum of the previous one
-and STEP. START defaults to 0 and STEP to 1. Returns N.
-
-Examples:
-
-  (map-iota #'print 3 :start 1 :step 1.0) => 3
-    ;;; 1.0
-    ;;; 2.0
-    ;;; 3.0
-"
-  (declare (type (integer 0) n) (number start step))
-  (loop ;; KLUDGE: get numeric contagion right for the first element too
-        for i = (+ start (- step step)) then (+ i step)
-        repeat n
-        do (funcall function i))
-  n)
-
-(declaim (inline lerp))
-(defun lerp (v a b)
-  "Returns the result of linear interpolation between A and B, using the
-interpolation coefficient V."
-  ;; The correct version is numerically stable, at the expense of an
-  ;; extra multiply. See (lerp 0.1 4 25) with (+ a (* v (- b a))). The
-  ;; unstable version can often be converted to a fast instruction on
-  ;; a lot of machines, though this is machine/implementation
-  ;; specific. As alexandria is more about correct code, than
-  ;; efficiency, and we're only talking about a single extra multiply,
-  ;; many would prefer the stable version
-  (+ (* (- 1.0 v) a) (* v b)))
-
-(declaim (inline mean))
-(defun mean (sample)
-  "Returns the mean of SAMPLE. SAMPLE must be a sequence of numbers."
-  (/ (reduce #'+ sample) (length sample)))
-
-(defun median (sample)
-  "Returns median of SAMPLE. SAMPLE must be a sequence of real numbers."
-  ;; Implements and uses the quick-select algorithm to find the median
-  ;; https://en.wikipedia.org/wiki/Quickselect
-
-  (labels ((randint-in-range (start-int end-int)
-             "Returns a random integer in the specified range, inclusive"
-             (+ start-int (random (1+ (- end-int start-int)))))
-           (partition (vec start-i end-i)
-             "Implements the partition function, which performs a partial
-              sort of vec around the (randomly) chosen pivot.
-              Returns the index where the pivot element would be located
-              in a correctly-sorted array"
-             (if (= start-i end-i)
-                 start-i
-                 (let ((pivot-i (randint-in-range start-i end-i)))
-                   (rotatef (aref vec start-i) (aref vec pivot-i))
-                   (let ((swap-i end-i))
-                     (loop for i from swap-i downto (1+ start-i) do
-                       (when (>= (aref vec i) (aref vec start-i))
-                         (rotatef (aref vec i) (aref vec swap-i))
-                         (decf swap-i)))
-                     (rotatef (aref vec swap-i) (aref vec start-i))
-                     swap-i)))))
-
-    (let* ((vector (copy-sequence 'vector sample))
-           (len (length vector))
-           (mid-i (ash len -1))
-           (i 0)
-           (j (1- len)))
-
-      (loop for correct-pos = (partition vector i j)
-            while (/= correct-pos mid-i) do
-              (if (< correct-pos mid-i)
-                  (setf i (1+ correct-pos))
-                  (setf j (1- correct-pos))))
-
-      (if (oddp len)
-          (aref vector mid-i)
-          (* 1/2
-             (+ (aref vector mid-i)
-                (reduce #'max (make-array
-                               mid-i
-                               :displaced-to vector))))))))
-
-(declaim (inline variance))
-(defun variance (sample &key (biased t))
-  "Variance of SAMPLE. Returns the biased variance if BIASED is true (the default),
-and the unbiased estimator of variance if BIASED is false. SAMPLE must be a
-sequence of numbers."
-  (let ((mean (mean sample)))
-    (/ (reduce (lambda (a b)
-                 (+ a (expt (- b mean) 2)))
-               sample
-               :initial-value 0)
-       (- (length sample) (if biased 0 1)))))
-
-(declaim (inline standard-deviation))
-(defun standard-deviation (sample &key (biased t))
-  "Standard deviation of SAMPLE. Returns the biased standard deviation if
-BIASED is true (the default), and the square root of the unbiased estimator
-for variance if BIASED is false (which is not the same as the unbiased
-estimator for standard deviation). SAMPLE must be a sequence of numbers."
-  (sqrt (variance sample :biased biased)))
-
-(define-modify-macro maxf (&rest numbers) max
-  "Modify-macro for MAX. Sets place designated by the first argument to the
-maximum of its original value and NUMBERS.")
-
-(define-modify-macro minf (&rest numbers) min
-  "Modify-macro for MIN. Sets place designated by the first argument to the
-minimum of its original value and NUMBERS.")
-
-;;;; Factorial
-
-;;; KLUDGE: This is really dependant on the numbers in question: for
-;;; small numbers this is larger, and vice versa. Ideally instead of a
-;;; constant we would have RANGE-FAST-TO-MULTIPLY-DIRECTLY-P.
-(defconstant +factorial-bisection-range-limit+ 8)
-
-;;; KLUDGE: This is really platform dependant: ideally we would use
-;;; (load-time-value (find-good-direct-multiplication-limit)) instead.
-(defconstant +factorial-direct-multiplication-limit+ 13)
-
-(defun %multiply-range (i j)
-  ;; We use a a bit of cleverness here:
-  ;;
-  ;; 1. For large factorials we bisect in order to avoid expensive bignum
-  ;;    multiplications: 1 x 2 x 3 x ... runs into bignums pretty soon,
-  ;;    and once it does that all further multiplications will be with bignums.
-  ;;
-  ;;    By instead doing the multiplication in a tree like
-  ;;       ((1 x 2) x (3 x 4)) x ((5 x 6) x (7 x 8))
-  ;;    we manage to get less bignums.
-  ;;
-  ;; 2. Division isn't exactly free either, however, so we don't bisect
-  ;;    all the way down, but multiply ranges of integers close to each
-  ;;    other directly.
-  ;;
-  ;; For even better results it should be possible to use prime
-  ;; factorization magic, but Nikodemus ran out of steam.
-  ;;
-  ;; KLUDGE: We support factorials of bignums, but it seems quite
-  ;; unlikely anyone would ever be able to use them on a modern lisp,
-  ;; since the resulting numbers are unlikely to fit in memory... but
-  ;; it would be extremely unelegant to define FACTORIAL only on
-  ;; fixnums, _and_ on lisps with 16 bit fixnums this can actually be
-  ;; needed.
-  (labels ((bisect (j k)
-             (declare (type (integer 1 #.most-positive-fixnum) j k))
-             (if (< (- k j) +factorial-bisection-range-limit+)
-                 (multiply-range j k)
-                 (let ((middle (+ j (truncate (- k j) 2))))
-                   (* (bisect j middle)
-                      (bisect (+ middle 1) k)))))
-           (bisect-big (j k)
-             (declare (type (integer 1) j k))
-             (if (= j k)
-                 j
-                 (let ((middle (+ j (truncate (- k j) 2))))
-                   (* (if (<= middle most-positive-fixnum)
-                          (bisect j middle)
-                          (bisect-big j middle))
-                      (bisect-big (+ middle 1) k)))))
-           (multiply-range (j k)
-             (declare (type (integer 1 #.most-positive-fixnum) j k))
-             (do ((f k (* f m))
-                  (m (1- k) (1- m)))
-                 ((< m j) f)
-               (declare (type (integer 0 (#.most-positive-fixnum)) m)
-                        (type unsigned-byte f)))))
-    (if (and (typep i 'fixnum) (typep j 'fixnum))
-        (bisect i j)
-        (bisect-big i j))))
-
-(declaim (inline factorial))
-(defun %factorial (n)
-  (if (< n 2)
-      1
-      (%multiply-range 1 n)))
-
-(defun factorial (n)
-  "Factorial of non-negative integer N."
-  (check-type n (integer 0))
-  (%factorial n))
-
-;;;; Combinatorics
-
-(defun binomial-coefficient (n k)
-  "Binomial coefficient of N and K, also expressed as N choose K. This is the
-number of K element combinations given N choises. N must be equal to or
-greater then K."
-  (check-type n (integer 0))
-  (check-type k (integer 0))
-  (assert (>= n k))
-  (if (or (zerop k) (= n k))
-      1
-      (let ((n-k (- n k)))
-        ;; Swaps K and N-K if K < N-K because the algorithm
-        ;; below is faster for bigger K and smaller N-K
-        (when (< k n-k)
-          (rotatef k n-k))
-        (if (= 1 n-k)
-            n
-            ;; General case, avoid computing the 1x...xK twice:
-            ;;
-            ;;    N!           1x...xN          (K+1)x...xN
-            ;; --------  =  ---------------- =  ------------, N>1
-            ;; K!(N-K)!     1x...xK x (N-K)!       (N-K)!
-            (/ (%multiply-range (+ k 1) n)
-               (%factorial n-k))))))
-
-(defun subfactorial (n)
-  "Subfactorial of the non-negative integer N."
-  (check-type n (integer 0))
-  (if (zerop n)
-      1
-      (do ((x 1 (1+ x))
-           (a 0 (* x (+ a b)))
-           (b 1 a))
-          ((= n x) a))))
-
-(defun count-permutations (n &optional (k n))
-  "Number of K element permutations for a sequence of N objects.
-K defaults to N"
-  (check-type n (integer 0))
-  (check-type k (integer 0))
-  (assert (>= n k))
-  (%multiply-range (1+ (- n k)) n))
diff --git a/third_party/lisp/alexandria/package.lisp b/third_party/lisp/alexandria/package.lisp
deleted file mode 100644
index f9d2014cd7b5..000000000000
--- a/third_party/lisp/alexandria/package.lisp
+++ /dev/null
@@ -1,243 +0,0 @@
-(defpackage :alexandria.1.0.0
-  (:nicknames :alexandria)
-  (:use :cl)
-  #+sb-package-locks
-  (:lock t)
-  (:export
-   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-   ;; BLESSED
-   ;;
-   ;; Binding constructs
-   #:if-let
-   #:when-let
-   #:when-let*
-   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-   ;; REVIEW IN PROGRESS
-   ;;
-   ;; Control flow
-   ;;
-   ;; -- no clear consensus yet --
-   #:cswitch
-   #:eswitch
-   #:switch
-   ;; -- problem free? --
-   #:multiple-value-prog2
-   #:nth-value-or
-   #:whichever
-   #:xor
-   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-   ;; REVIEW PENDING
-   ;;
-   ;; Definitions
-   #:define-constant
-   ;; Hash tables
-   #:alist-hash-table
-   #:copy-hash-table
-   #:ensure-gethash
-   #:hash-table-alist
-   #:hash-table-keys
-   #:hash-table-plist
-   #:hash-table-values
-   #:maphash-keys
-   #:maphash-values
-   #:plist-hash-table
-   ;; Functions
-   #:compose
-   #:conjoin
-   #:curry
-   #:disjoin
-   #:ensure-function
-   #:ensure-functionf
-   #:multiple-value-compose
-   #:named-lambda
-   #:rcurry
-   ;; Lists
-   #:alist-plist
-   #:appendf
-   #:nconcf
-   #:reversef
-   #:nreversef
-   #:circular-list
-   #:circular-list-p
-   #:circular-tree-p
-   #:doplist
-   #:ensure-car
-   #:ensure-cons
-   #:ensure-list
-   #:flatten
-   #:lastcar
-   #:make-circular-list
-   #:map-product
-   #:mappend
-   #:nunionf
-   #:plist-alist
-   #:proper-list
-   #:proper-list-length
-   #:proper-list-p
-   #:remove-from-plist
-   #:remove-from-plistf
-   #:delete-from-plist
-   #:delete-from-plistf
-   #:set-equal
-   #:setp
-   #:unionf
-   ;; Numbers
-   #:binomial-coefficient
-   #:clamp
-   #:count-permutations
-   #:factorial
-   #:gaussian-random
-   #:iota
-   #:lerp
-   #:map-iota
-   #:maxf
-   #:mean
-   #:median
-   #:minf
-   #:standard-deviation
-   #:subfactorial
-   #:variance
-   ;; Arrays
-   #:array-index
-   #:array-length
-   #:copy-array
-   ;; Sequences
-   #:copy-sequence
-   #:deletef
-   #:emptyp
-   #:ends-with
-   #:ends-with-subseq
-   #:extremum
-   #:first-elt
-   #:last-elt
-   #:length=
-   #:map-combinations
-   #:map-derangements
-   #:map-permutations
-   #:proper-sequence
-   #:random-elt
-   #:removef
-   #:rotate
-   #:sequence-of-length-p
-   #:shuffle
-   #:starts-with
-   #:starts-with-subseq
-   ;; Macros
-   #:once-only
-   #:parse-body
-   #:parse-ordinary-lambda-list
-   #:with-gensyms
-   #:with-unique-names
-   ;; Symbols
-   #:ensure-symbol
-   #:format-symbol
-   #:make-gensym
-   #:make-gensym-list
-   #:make-keyword
-   ;; Strings
-   #:string-designator
-   ;; Types
-   #:negative-double-float
-   #:negative-fixnum-p
-   #:negative-float
-   #:negative-float-p
-   #:negative-long-float
-   #:negative-long-float-p
-   #:negative-rational
-   #:negative-rational-p
-   #:negative-real
-   #:negative-single-float-p
-   #:non-negative-double-float
-   #:non-negative-double-float-p
-   #:non-negative-fixnum
-   #:non-negative-fixnum-p
-   #:non-negative-float
-   #:non-negative-float-p
-   #:non-negative-integer-p
-   #:non-negative-long-float
-   #:non-negative-rational
-   #:non-negative-real-p
-   #:non-negative-short-float-p
-   #:non-negative-single-float
-   #:non-negative-single-float-p
-   #:non-positive-double-float
-   #:non-positive-double-float-p
-   #:non-positive-fixnum
-   #:non-positive-fixnum-p
-   #:non-positive-float
-   #:non-positive-float-p
-   #:non-positive-integer
-   #:non-positive-rational
-   #:non-positive-real
-   #:non-positive-real-p
-   #:non-positive-short-float
-   #:non-positive-short-float-p
-   #:non-positive-single-float-p
-   #:positive-double-float
-   #:positive-double-float-p
-   #:positive-fixnum
-   #:positive-fixnum-p
-   #:positive-float
-   #:positive-float-p
-   #:positive-integer
-   #:positive-rational
-   #:positive-real
-   #:positive-real-p
-   #:positive-short-float
-   #:positive-short-float-p
-   #:positive-single-float
-   #:positive-single-float-p
-   #:coercef
-   #:negative-double-float-p
-   #:negative-fixnum
-   #:negative-integer
-   #:negative-integer-p
-   #:negative-real-p
-   #:negative-short-float
-   #:negative-short-float-p
-   #:negative-single-float
-   #:non-negative-integer
-   #:non-negative-long-float-p
-   #:non-negative-rational-p
-   #:non-negative-real
-   #:non-negative-short-float
-   #:non-positive-integer-p
-   #:non-positive-long-float
-   #:non-positive-long-float-p
-   #:non-positive-rational-p
-   #:non-positive-single-float
-   #:of-type
-   #:positive-integer-p
-   #:positive-long-float
-   #:positive-long-float-p
-   #:positive-rational-p
-   #:type=
-   ;; Conditions
-   #:required-argument
-   #:ignore-some-conditions
-   #:simple-style-warning
-   #:simple-reader-error
-   #:simple-parse-error
-   #:simple-program-error
-   #:unwind-protect-case
-   ;; Features
-   #:featurep
-   ;; io
-   #:with-input-from-file
-   #:with-output-to-file
-   #:read-stream-content-into-string
-   #:read-file-into-string
-   #:write-string-into-file
-   #:read-stream-content-into-byte-vector
-   #:read-file-into-byte-vector
-   #:write-byte-vector-into-file
-   #:copy-stream
-   #:copy-file
-   ;; new additions collected at the end (subject to removal or further changes)
-   #:symbolicate
-   #:assoc-value
-   #:rassoc-value
-   #:destructuring-case
-   #:destructuring-ccase
-   #:destructuring-ecase
-   ))
diff --git a/third_party/lisp/alexandria/sequences.lisp b/third_party/lisp/alexandria/sequences.lisp
deleted file mode 100644
index 21464f537610..000000000000
--- a/third_party/lisp/alexandria/sequences.lisp
+++ /dev/null
@@ -1,555 +0,0 @@
-(in-package :alexandria)
-
-;; Make these inlinable by declaiming them INLINE here and some of them
-;; NOTINLINE at the end of the file. Exclude functions that have a compiler
-;; macro, because NOTINLINE is required to prevent compiler-macro expansion.
-(declaim (inline copy-sequence sequence-of-length-p))
-
-(defun sequence-of-length-p (sequence length)
-  "Return true if SEQUENCE is a sequence of length LENGTH. Signals an error if
-SEQUENCE is not a sequence. Returns FALSE for circular lists."
-  (declare (type array-index length)
-           #-lispworks (inline length)
-           (optimize speed))
-  (etypecase sequence
-    (null
-     (zerop length))
-    (cons
-     (let ((n (1- length)))
-       (unless (minusp n)
-         (let ((tail (nthcdr n sequence)))
-           (and tail
-                (null (cdr tail)))))))
-    (vector
-     (= length (length sequence)))
-    (sequence
-     (= length (length sequence)))))
-
-(defun rotate-tail-to-head (sequence n)
-  (declare (type (integer 1) n))
-  (if (listp sequence)
-      (let ((m (mod n (proper-list-length sequence))))
-        (if (null (cdr sequence))
-            sequence
-            (let* ((tail (last sequence (+ m 1)))
-                   (last (cdr tail)))
-              (setf (cdr tail) nil)
-              (nconc last sequence))))
-      (let* ((len (length sequence))
-             (m (mod n len))
-             (tail (subseq sequence (- len m))))
-        (replace sequence sequence :start1 m :start2 0)
-        (replace sequence tail)
-        sequence)))
-
-(defun rotate-head-to-tail (sequence n)
-  (declare (type (integer 1) n))
-  (if (listp sequence)
-      (let ((m (mod (1- n) (proper-list-length sequence))))
-        (if (null (cdr sequence))
-            sequence
-            (let* ((headtail (nthcdr m sequence))
-                   (tail (cdr headtail)))
-              (setf (cdr headtail) nil)
-              (nconc tail sequence))))
-      (let* ((len (length sequence))
-             (m (mod n len))
-             (head (subseq sequence 0 m)))
-        (replace sequence sequence :start1 0 :start2 m)
-        (replace sequence head :start1 (- len m))
-        sequence)))
-
-(defun rotate (sequence &optional (n 1))
-  "Returns a sequence of the same type as SEQUENCE, with the elements of
-SEQUENCE rotated by N: N elements are moved from the end of the sequence to
-the front if N is positive, and -N elements moved from the front to the end if
-N is negative. SEQUENCE must be a proper sequence. N must be an integer,
-defaulting to 1.
-
-If absolute value of N is greater then the length of the sequence, the results
-are identical to calling ROTATE with
-
-  (* (signum n) (mod n (length sequence))).
-
-Note: the original sequence may be destructively altered, and result sequence may
-share structure with it."
-  (if (plusp n)
-      (rotate-tail-to-head sequence n)
-      (if (minusp n)
-          (rotate-head-to-tail sequence (- n))
-          sequence)))
-
-(defun shuffle (sequence &key (start 0) end)
-  "Returns a random permutation of SEQUENCE bounded by START and END.
-Original sequence may be destructively modified, and (if it contains
-CONS or lists themselv) share storage with the original one.
-Signals an error if SEQUENCE is not a proper sequence."
-  (declare (type fixnum start)
-           (type (or fixnum null) end))
-  (etypecase sequence
-    (list
-     (let* ((end (or end (proper-list-length sequence)))
-            (n (- end start)))
-       (do ((tail (nthcdr start sequence) (cdr tail)))
-           ((zerop n))
-         (rotatef (car tail) (car (nthcdr (random n) tail)))
-         (decf n))))
-    (vector
-     (let ((end (or end (length sequence))))
-       (loop for i from start below end
-             do (rotatef (aref sequence i)
-                         (aref sequence (+ i (random (- end i))))))))
-    (sequence
-     (let ((end (or end (length sequence))))
-       (loop for i from (- end 1) downto start
-             do (rotatef (elt sequence i)
-                         (elt sequence (+ i (random (- end i)))))))))
-  sequence)
-
-(defun random-elt (sequence &key (start 0) end)
-  "Returns a random element from SEQUENCE bounded by START and END. Signals an
-error if the SEQUENCE is not a proper non-empty sequence, or if END and START
-are not proper bounding index designators for SEQUENCE."
-  (declare (sequence sequence) (fixnum start) (type (or fixnum null) end))
-  (let* ((size (if (listp sequence)
-                   (proper-list-length sequence)
-                   (length sequence)))
-         (end2 (or end size)))
-    (cond ((zerop size)
-           (error 'type-error
-                  :datum sequence
-                  :expected-type `(and sequence (not (satisfies emptyp)))))
-          ((not (and (<= 0 start) (< start end2) (<= end2 size)))
-           (error 'simple-type-error
-                  :datum (cons start end)
-                  :expected-type `(cons (integer 0 (,end2))
-                                        (or null (integer (,start) ,size)))
-                  :format-control "~@<~S and ~S are not valid bounding index designators for ~
-                                   a sequence of length ~S.~:@>"
-                  :format-arguments (list start end size)))
-          (t
-           (let ((index (+ start (random (- end2 start)))))
-             (elt sequence index))))))
-
-(declaim (inline remove/swapped-arguments))
-(defun remove/swapped-arguments (sequence item &rest keyword-arguments)
-  (apply #'remove item sequence keyword-arguments))
-
-(define-modify-macro removef (item &rest keyword-arguments)
-  remove/swapped-arguments
-  "Modify-macro for REMOVE. Sets place designated by the first argument to
-the result of calling REMOVE with ITEM, place, and the KEYWORD-ARGUMENTS.")
-
-(declaim (inline delete/swapped-arguments))
-(defun delete/swapped-arguments (sequence item &rest keyword-arguments)
-  (apply #'delete item sequence keyword-arguments))
-
-(define-modify-macro deletef (item &rest keyword-arguments)
-  delete/swapped-arguments
-  "Modify-macro for DELETE. Sets place designated by the first argument to
-the result of calling DELETE with ITEM, place, and the KEYWORD-ARGUMENTS.")
-
-(deftype proper-sequence ()
-  "Type designator for proper sequences, that is proper lists and sequences
-that are not lists."
-  `(or proper-list
-       (and (not list) sequence)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (when (and (find-package '#:sequence)
-             (find-symbol (string '#:emptyp) '#:sequence))
-    (pushnew 'sequence-emptyp *features*)))
-
-#-alexandria::sequence-emptyp
-(defun emptyp (sequence)
-  "Returns true if SEQUENCE is an empty sequence. Signals an error if SEQUENCE
-is not a sequence."
-  (etypecase sequence
-    (list (null sequence))
-    (sequence (zerop (length sequence)))))
-
-#+alexandria::sequence-emptyp
-(declaim (ftype (function (sequence) (values boolean &optional)) emptyp))
-#+alexandria::sequence-emptyp
-(setf (symbol-function 'emptyp) (symbol-function 'sequence:emptyp))
-#+alexandria::sequence-emptyp
-(define-compiler-macro emptyp (sequence)
-  `(sequence:emptyp ,sequence))
-
-(defun length= (&rest sequences)
-  "Takes any number of sequences or integers in any order. Returns true iff
-the length of all the sequences and the integers are equal. Hint: there's a
-compiler macro that expands into more efficient code if the first argument
-is a literal integer."
-  (declare (dynamic-extent sequences)
-           (inline sequence-of-length-p)
-           (optimize speed))
-  (unless (cdr sequences)
-    (error "You must call LENGTH= with at least two arguments"))
-  ;; There's room for optimization here: multiple list arguments could be
-  ;; traversed in parallel.
-  (let* ((first (pop sequences))
-         (current (if (integerp first)
-                      first
-                      (length first))))
-    (declare (type array-index current))
-    (dolist (el sequences)
-      (if (integerp el)
-          (unless (= el current)
-            (return-from length= nil))
-          (unless (sequence-of-length-p el current)
-            (return-from length= nil)))))
-  t)
-
-(define-compiler-macro length= (&whole form length &rest sequences)
-  (cond
-    ((zerop (length sequences))
-     form)
-    (t
-     (let ((optimizedp (integerp length)))
-       (with-unique-names (tmp current)
-         (declare (ignorable current))
-         `(locally
-              (declare (inline sequence-of-length-p))
-            (let ((,tmp)
-                  ,@(unless optimizedp
-                     `((,current ,length))))
-              ,@(unless optimizedp
-                  `((unless (integerp ,current)
-                      (setf ,current (length ,current)))))
-              (and
-               ,@(loop
-                    :for sequence :in sequences
-                    :collect `(progn
-                                (setf ,tmp ,sequence)
-                                (if (integerp ,tmp)
-                                    (= ,tmp ,(if optimizedp
-                                                 length
-                                                 current))
-                                    (sequence-of-length-p ,tmp ,(if optimizedp
-                                                                    length
-                                                                    current)))))))))))))
-
-(defun copy-sequence (type sequence)
-  "Returns a fresh sequence of TYPE, which has the same elements as
-SEQUENCE."
-  (if (typep sequence type)
-      (copy-seq sequence)
-      (coerce sequence type)))
-
-(defun first-elt (sequence)
-  "Returns the first element of SEQUENCE. Signals a type-error if SEQUENCE is
-not a sequence, or is an empty sequence."
-  ;; Can't just directly use ELT, as it is not guaranteed to signal the
-  ;; type-error.
-  (cond  ((consp sequence)
-          (car sequence))
-         ((and (typep sequence 'sequence) (not (emptyp sequence)))
-          (elt sequence 0))
-         (t
-          (error 'type-error
-                 :datum sequence
-                 :expected-type '(and sequence (not (satisfies emptyp)))))))
-
-(defun (setf first-elt) (object sequence)
-  "Sets the first element of SEQUENCE. Signals a type-error if SEQUENCE is
-not a sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENCE."
-  ;; Can't just directly use ELT, as it is not guaranteed to signal the
-  ;; type-error.
-  (cond ((consp sequence)
-         (setf (car sequence) object))
-        ((and (typep sequence 'sequence) (not (emptyp sequence)))
-         (setf (elt sequence 0) object))
-        (t
-         (error 'type-error
-                :datum sequence
-                :expected-type '(and sequence (not (satisfies emptyp)))))))
-
-(defun last-elt (sequence)
-  "Returns the last element of SEQUENCE. Signals a type-error if SEQUENCE is
-not a proper sequence, or is an empty sequence."
-  ;; Can't just directly use ELT, as it is not guaranteed to signal the
-  ;; type-error.
-  (let ((len 0))
-    (cond ((consp sequence)
-           (lastcar sequence))
-          ((and (typep sequence '(and sequence (not list))) (plusp (setf len (length sequence))))
-           (elt sequence (1- len)))
-          (t
-           (error 'type-error
-                  :datum sequence
-                  :expected-type '(and proper-sequence (not (satisfies emptyp))))))))
-
-(defun (setf last-elt) (object sequence)
-  "Sets the last element of SEQUENCE. Signals a type-error if SEQUENCE is not a proper
-sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENCE."
-  (let ((len 0))
-    (cond ((consp sequence)
-           (setf (lastcar sequence) object))
-          ((and (typep sequence '(and sequence (not list))) (plusp (setf len (length sequence))))
-           (setf (elt sequence (1- len)) object))
-          (t
-           (error 'type-error
-                  :datum sequence
-                  :expected-type '(and proper-sequence (not (satisfies emptyp))))))))
-
-(defun starts-with-subseq (prefix sequence &rest args
-                           &key
-                           (return-suffix nil return-suffix-supplied-p)
-                           &allow-other-keys)
-  "Test whether the first elements of SEQUENCE are the same (as per TEST) as the elements of PREFIX.
-
-If RETURN-SUFFIX is T the function returns, as a second value, a
-sub-sequence or displaced array pointing to the sequence after PREFIX."
-  (declare (dynamic-extent args))
-  (let ((sequence-length (length sequence))
-        (prefix-length (length prefix)))
-    (when (< sequence-length prefix-length)
-      (return-from starts-with-subseq (values nil nil)))
-    (flet ((make-suffix (start)
-             (when return-suffix
-               (cond
-                 ((not (arrayp sequence))
-                  (if start
-                      (subseq sequence start)
-                      (subseq sequence 0 0)))
-                 ((not start)
-                  (make-array 0
-                              :element-type (array-element-type sequence)
-                              :adjustable nil))
-                 (t
-                  (make-array (- sequence-length start)
-                              :element-type (array-element-type sequence)
-                              :displaced-to sequence
-                              :displaced-index-offset start
-                              :adjustable nil))))))
-      (let ((mismatch (apply #'mismatch prefix sequence
-                             (if return-suffix-supplied-p
-                                 (remove-from-plist args :return-suffix)
-                                 args))))
-        (cond
-          ((not mismatch)
-           (values t (make-suffix nil)))
-          ((= mismatch prefix-length)
-           (values t (make-suffix mismatch)))
-          (t
-           (values nil nil)))))))
-
-(defun ends-with-subseq (suffix sequence &key (test #'eql))
-  "Test whether SEQUENCE ends with SUFFIX. In other words: return true if
-the last (length SUFFIX) elements of SEQUENCE are equal to SUFFIX."
-  (let ((sequence-length (length sequence))
-        (suffix-length (length suffix)))
-    (when (< sequence-length suffix-length)
-      ;; if SEQUENCE is shorter than SUFFIX, then SEQUENCE can't end with SUFFIX.
-      (return-from ends-with-subseq nil))
-    (loop for sequence-index from (- sequence-length suffix-length) below sequence-length
-          for suffix-index from 0 below suffix-length
-          when (not (funcall test (elt sequence sequence-index) (elt suffix suffix-index)))
-          do (return-from ends-with-subseq nil)
-          finally (return t))))
-
-(defun starts-with (object sequence &key (test #'eql) (key #'identity))
-  "Returns true if SEQUENCE is a sequence whose first element is EQL to OBJECT.
-Returns NIL if the SEQUENCE is not a sequence or is an empty sequence."
-  (let ((first-elt (typecase sequence
-                     (cons (car sequence))
-                     (sequence
-                      (if (emptyp sequence)
-                          (return-from starts-with nil)
-                          (elt sequence 0)))
-                     (t
-                      (return-from starts-with nil)))))
-    (funcall test (funcall key first-elt) object)))
-
-(defun ends-with (object sequence &key (test #'eql) (key #'identity))
-  "Returns true if SEQUENCE is a sequence whose last element is EQL to OBJECT.
-Returns NIL if the SEQUENCE is not a sequence or is an empty sequence. Signals
-an error if SEQUENCE is an improper list."
-  (let ((last-elt (typecase sequence
-                    (cons
-                     (lastcar sequence)) ; signals for improper lists
-                    (sequence
-                     ;; Can't use last-elt, as that signals an error
-                     ;; for empty sequences
-                     (let ((len (length sequence)))
-                       (if (plusp len)
-                           (elt sequence (1- len))
-                           (return-from ends-with nil))))
-                    (t
-                     (return-from ends-with nil)))))
-    (funcall test (funcall key last-elt) object)))
-
-(defun map-combinations (function sequence &key (start 0) end length (copy t))
-  "Calls FUNCTION with each combination of LENGTH constructable from the
-elements of the subsequence of SEQUENCE delimited by START and END. START
-defaults to 0, END to length of SEQUENCE, and LENGTH to the length of the
-delimited subsequence. (So unless LENGTH is specified there is only a single
-combination, which has the same elements as the delimited subsequence.) If
-COPY is true (the default) each combination is freshly allocated. If COPY is
-false all combinations are EQ to each other, in which case consequences are
-unspecified if a combination is modified by FUNCTION."
-  (let* ((end (or end (length sequence)))
-         (size (- end start))
-         (length (or length size))
-         (combination (subseq sequence 0 length))
-         (function (ensure-function function)))
-    (if (= length size)
-        (funcall function combination)
-        (flet ((call ()
-                 (funcall function (if copy
-                                       (copy-seq combination)
-                                       combination))))
-          (etypecase sequence
-            ;; When dealing with lists we prefer walking back and
-            ;; forth instead of using indexes.
-            (list
-             (labels ((combine-list (c-tail o-tail)
-                        (if (not c-tail)
-                            (call)
-                            (do ((tail o-tail (cdr tail)))
-                                ((not tail))
-                              (setf (car c-tail) (car tail))
-                              (combine-list (cdr c-tail) (cdr tail))))))
-               (combine-list combination (nthcdr start sequence))))
-            (vector
-             (labels ((combine (count start)
-                        (if (zerop count)
-                            (call)
-                            (loop for i from start below end
-                                  do (let ((j (- count 1)))
-                                       (setf (aref combination j) (aref sequence i))
-                                       (combine j (+ i 1)))))))
-               (combine length start)))
-            (sequence
-             (labels ((combine (count start)
-                        (if (zerop count)
-                            (call)
-                            (loop for i from start below end
-                                  do (let ((j (- count 1)))
-                                       (setf (elt combination j) (elt sequence i))
-                                       (combine j (+ i 1)))))))
-               (combine length start)))))))
-  sequence)
-
-(defun map-permutations (function sequence &key (start 0) end length (copy t))
-  "Calls function with each permutation of LENGTH constructable
-from the subsequence of SEQUENCE delimited by START and END. START
-defaults to 0, END to length of the sequence, and LENGTH to the
-length of the delimited subsequence."
-  (let* ((end (or end (length sequence)))
-         (size (- end start))
-         (length (or length size)))
-    (labels ((permute (seq n)
-               (let ((n-1 (- n 1)))
-                 (if (zerop n-1)
-                     (funcall function (if copy
-                                           (copy-seq seq)
-                                           seq))
-                     (loop for i from 0 upto n-1
-                           do (permute seq n-1)
-                           (if (evenp n-1)
-                               (rotatef (elt seq 0) (elt seq n-1))
-                               (rotatef (elt seq i) (elt seq n-1)))))))
-             (permute-sequence (seq)
-               (permute seq length)))
-      (if (= length size)
-          ;; Things are simple if we need to just permute the
-          ;; full START-END range.
-          (permute-sequence (subseq sequence start end))
-          ;; Otherwise we need to generate all the combinations
-          ;; of LENGTH in the START-END range, and then permute
-          ;; a copy of the result: can't permute the combination
-          ;; directly, as they share structure with each other.
-          (let ((permutation (subseq sequence 0 length)))
-            (flet ((permute-combination (combination)
-                     (permute-sequence (replace permutation combination))))
-              (declare (dynamic-extent #'permute-combination))
-              (map-combinations #'permute-combination sequence
-                                :start start
-                                :end end
-                                :length length
-                                :copy nil)))))))
-
-(defun map-derangements (function sequence &key (start 0) end (copy t))
-  "Calls FUNCTION with each derangement of the subsequence of SEQUENCE denoted
-by the bounding index designators START and END. Derangement is a permutation
-of the sequence where no element remains in place. SEQUENCE is not modified,
-but individual derangements are EQ to each other. Consequences are unspecified
-if calling FUNCTION modifies either the derangement or SEQUENCE."
-  (let* ((end (or end (length sequence)))
-         (size (- end start))
-         ;; We don't really care about the elements here.
-         (derangement (subseq sequence 0 size))
-         ;; Bitvector that has 1 for elements that have been deranged.
-         (mask (make-array size :element-type 'bit :initial-element 0)))
-    (declare (dynamic-extent mask))
-    ;; ad hoc algorith
-    (labels ((derange (place n)
-               ;; Perform one recursive step in deranging the
-               ;; sequence: PLACE is index of the original sequence
-               ;; to derange to another index, and N is the number of
-               ;; indexes not yet deranged.
-               (if (zerop n)
-                   (funcall function (if copy
-                                         (copy-seq derangement)
-                                         derangement))
-                   ;; Itarate over the indexes I of the subsequence to
-                   ;; derange: if I != PLACE and I has not yet been
-                   ;; deranged by an earlier call put the element from
-                   ;; PLACE to I, mark I as deranged, and recurse,
-                   ;; finally removing the mark.
-                   (loop for i from 0 below size
-                         do
-                         (unless (or (= place (+ i start)) (not (zerop (bit mask i))))
-                           (setf (elt derangement i) (elt sequence place)
-                                 (bit mask i) 1)
-                           (derange (1+ place) (1- n))
-                           (setf (bit mask i) 0))))))
-      (derange start size)
-      sequence)))
-
-(declaim (notinline sequence-of-length-p))
-
-(defun extremum (sequence predicate &key key (start 0) end)
-  "Returns the element of SEQUENCE that would appear first if the subsequence
-bounded by START and END was sorted using PREDICATE and KEY.
-
-EXTREMUM determines the relationship between two elements of SEQUENCE by using
-the PREDICATE function. PREDICATE should return true if and only if the first
-argument is strictly less than the second one (in some appropriate sense). Two
-arguments X and Y are considered to be equal if (FUNCALL PREDICATE X Y)
-and (FUNCALL PREDICATE Y X) are both false.
-
-The arguments to the PREDICATE function are computed from elements of SEQUENCE
-using the KEY function, if supplied. If KEY is not supplied or is NIL, the
-sequence element itself is used.
-
-If SEQUENCE is empty, NIL is returned."
-  (let* ((pred-fun (ensure-function predicate))
-         (key-fun (unless (or (not key) (eq key 'identity) (eq key #'identity))
-                    (ensure-function key)))
-         (real-end (or end (length sequence))))
-    (cond ((> real-end start)
-           (if key-fun
-               (flet ((reduce-keys (a b)
-                        (if (funcall pred-fun
-                                     (funcall key-fun a)
-                                     (funcall key-fun b))
-                            a
-                            b)))
-                 (declare (dynamic-extent #'reduce-keys))
-                 (reduce #'reduce-keys sequence :start start :end real-end))
-               (flet ((reduce-elts (a b)
-                        (if (funcall pred-fun a b)
-                            a
-                            b)))
-                 (declare (dynamic-extent #'reduce-elts))
-                 (reduce #'reduce-elts sequence :start start :end real-end))))
-          ((= real-end start)
-           nil)
-          (t
-           (error "Invalid bounding indexes for sequence of length ~S: ~S ~S, ~S ~S"
-                  (length sequence)
-                  :start start
-                  :end end)))))
diff --git a/third_party/lisp/alexandria/strings.lisp b/third_party/lisp/alexandria/strings.lisp
deleted file mode 100644
index e9fd91c96155..000000000000
--- a/third_party/lisp/alexandria/strings.lisp
+++ /dev/null
@@ -1,6 +0,0 @@
-(in-package :alexandria)
-
-(deftype string-designator ()
-  "A string designator type. A string designator is either a string, a symbol,
-or a character."
-  `(or symbol string character))
diff --git a/third_party/lisp/alexandria/symbols.lisp b/third_party/lisp/alexandria/symbols.lisp
deleted file mode 100644
index 5733d3e1cc50..000000000000
--- a/third_party/lisp/alexandria/symbols.lisp
+++ /dev/null
@@ -1,65 +0,0 @@
-(in-package :alexandria)
-
-(declaim (inline ensure-symbol))
-(defun ensure-symbol (name &optional (package *package*))
-  "Returns a symbol with name designated by NAME, accessible in package
-designated by PACKAGE. If symbol is not already accessible in PACKAGE, it is
-interned there. Returns a secondary value reflecting the status of the symbol
-in the package, which matches the secondary return value of INTERN.
-
-Example:
-
-  (ensure-symbol :cons :cl) => cl:cons, :external
-"
-  (intern (string name) package))
-
-(defun maybe-intern (name package)
-  (values
-   (if package
-       (intern name (if (eq t package) *package* package))
-       (make-symbol name))))
-
-(declaim (inline format-symbol))
-(defun format-symbol (package control &rest arguments)
-  "Constructs a string by applying ARGUMENTS to string designator CONTROL as
-if by FORMAT within WITH-STANDARD-IO-SYNTAX, and then creates a symbol named
-by that string.
-
-If PACKAGE is NIL, returns an uninterned symbol, if package is T, returns a
-symbol interned in the current package, and otherwise returns a symbol
-interned in the package designated by PACKAGE."
-  (maybe-intern (with-standard-io-syntax
-                  (apply #'format nil (string control) arguments))
-                package))
-
-(defun make-keyword (name)
-  "Interns the string designated by NAME in the KEYWORD package."
-  (intern (string name) :keyword))
-
-(defun make-gensym (name)
-  "If NAME is a non-negative integer, calls GENSYM using it. Otherwise NAME
-must be a string designator, in which case calls GENSYM using the designated
-string as the argument."
-  (gensym (if (typep name '(integer 0))
-              name
-              (string name))))
-
-(defun make-gensym-list (length &optional (x "G"))
-  "Returns a list of LENGTH gensyms, each generated as if with a call to MAKE-GENSYM,
-using the second (optional, defaulting to \"G\") argument."
-  (let ((g (if (typep x '(integer 0)) x (string x))))
-    (loop repeat length
-          collect (gensym g))))
-
-(defun symbolicate (&rest things)
-  "Concatenate together the names of some strings and symbols,
-producing a symbol in the current package."
-  (let* ((length (reduce #'+ things
-                         :key (lambda (x) (length (string x)))))
-         (name (make-array length :element-type 'character)))
-    (let ((index 0))
-      (dolist (thing things (values (intern name)))
-        (let* ((x (string thing))
-               (len (length x)))
-          (replace name x :start1 index)
-          (incf index len))))))
diff --git a/third_party/lisp/alexandria/tests.lisp b/third_party/lisp/alexandria/tests.lisp
deleted file mode 100644
index b70ef0475e81..000000000000
--- a/third_party/lisp/alexandria/tests.lisp
+++ /dev/null
@@ -1,2047 +0,0 @@
-(in-package :cl-user)
-
-(defpackage :alexandria-tests
-  (:use :cl :alexandria #+sbcl :sb-rt #-sbcl :rtest)
-  (:import-from #+sbcl :sb-rt #-sbcl :rtest
-                #:*compile-tests* #:*expected-failures*))
-
-(in-package :alexandria-tests)
-
-(defun run-tests (&key ((:compiled *compile-tests*)))
-  (do-tests))
-
-(defun hash-table-test-name (name)
-  ;; Workaround for Clisp calling EQL in a hash-table FASTHASH-EQL.
-  (hash-table-test (make-hash-table :test name)))
-
-;;;; Arrays
-
-(deftest copy-array.1
-    (let* ((orig (vector 1 2 3))
-           (copy (copy-array orig)))
-      (values (eq orig copy) (equalp orig copy)))
-  nil t)
-
-(deftest copy-array.2
-    (let ((orig (make-array 1024 :fill-pointer 0)))
-      (vector-push-extend 1 orig)
-      (vector-push-extend 2 orig)
-      (vector-push-extend 3 orig)
-      (let ((copy (copy-array orig)))
-        (values (eq orig copy) (equalp orig copy)
-                (array-has-fill-pointer-p copy)
-                (eql (fill-pointer orig) (fill-pointer copy)))))
-  nil t t t)
-
-(deftest copy-array.3
-    (let* ((orig (vector 1 2 3))
-           (copy (copy-array orig)))
-      (typep copy 'simple-array))
-  t)
-
-(deftest copy-array.4
-   (let ((orig (make-array 21
-                           :adjustable t
-                           :fill-pointer 0)))
-     (dotimes (n 42)
-       (vector-push-extend n orig))
-     (let ((copy (copy-array orig
-                             :adjustable nil
-                             :fill-pointer nil)))
-       (typep copy 'simple-array)))
- t)
-
-(deftest array-index.1
-    (typep 0 'array-index)
-  t)
-
-;;;; Conditions
-
-(deftest unwind-protect-case.1
-    (let (result)
-      (unwind-protect-case ()
-          (random 10)
-        (:normal (push :normal result))
-        (:abort  (push :abort result))
-        (:always (push :always result)))
-      result)
-  (:always :normal))
-
-(deftest unwind-protect-case.2
-    (let (result)
-      (unwind-protect-case ()
-          (random 10)
-        (:always (push :always result))
-        (:normal (push :normal result))
-        (:abort  (push :abort result)))
-      result)
-  (:normal :always))
-
-(deftest unwind-protect-case.3
-    (let (result1 result2 result3)
-      (ignore-errors
-        (unwind-protect-case ()
-            (error "FOOF!")
-          (:normal (push :normal result1))
-          (:abort  (push :abort result1))
-          (:always (push :always result1))))
-      (catch 'foof
-        (unwind-protect-case ()
-            (throw 'foof 42)
-          (:normal (push :normal result2))
-          (:abort  (push :abort result2))
-          (:always (push :always result2))))
-      (block foof
-        (unwind-protect-case ()
-            (return-from foof 42)
-          (:normal (push :normal result3))
-          (:abort  (push :abort result3))
-          (:always (push :always result3))))
-      (values result1 result2 result3))
-  (:always :abort)
-  (:always :abort)
-  (:always :abort))
-
-(deftest unwind-protect-case.4
-    (let (result)
-      (unwind-protect-case (aborted-p)
-          (random 42)
-        (:always (setq result aborted-p)))
-      result)
-  nil)
-
-(deftest unwind-protect-case.5
-    (let (result)
-      (block foof
-        (unwind-protect-case (aborted-p)
-            (return-from foof)
-          (:always (setq result aborted-p))))
-      result)
-  t)
-
-;;;; Control flow
-
-(deftest switch.1
-    (switch (13 :test =)
-      (12 :oops)
-      (13.0 :yay))
-  :yay)
-
-(deftest switch.2
-    (switch (13)
-      ((+ 12 2) :oops)
-      ((- 13 1) :oops2)
-      (t :yay))
-  :yay)
-
-(deftest eswitch.1
-    (let ((x 13))
-      (eswitch (x :test =)
-        (12 :oops)
-        (13.0 :yay)))
-  :yay)
-
-(deftest eswitch.2
-    (let ((x 13))
-      (eswitch (x :key 1+)
-        (11 :oops)
-        (14 :yay)))
-  :yay)
-
-(deftest cswitch.1
-    (cswitch (13 :test =)
-      (12 :oops)
-      (13.0 :yay))
-  :yay)
-
-(deftest cswitch.2
-    (cswitch (13 :key 1-)
-      (12 :yay)
-      (13.0 :oops))
-  :yay)
-
-(deftest multiple-value-prog2.1
-    (multiple-value-prog2
-        (values 1 1 1)
-        (values 2 20 200)
-      (values 3 3 3))
-  2 20 200)
-
-(deftest nth-value-or.1
-    (multiple-value-bind (a b c)
-        (nth-value-or 1
-                      (values 1 nil 1)
-                      (values 2 2 2))
-      (= a b c 2))
-  t)
-
-(deftest whichever.1
-    (let ((x (whichever 1 2 3)))
-      (and (member x '(1 2 3)) t))
-  t)
-
-(deftest whichever.2
-    (let* ((a 1)
-           (b 2)
-           (c 3)
-           (x (whichever a b c)))
-      (and (member x '(1 2 3)) t))
-  t)
-
-(deftest xor.1
-    (xor nil nil 1 nil)
-  1
-  t)
-
-(deftest xor.2
-    (xor nil nil 1 2)
-  nil
-  nil)
-
-(deftest xor.3
-    (xor nil nil nil)
-  nil
-  t)
-
-;;;; Definitions
-
-(deftest define-constant.1
-    (let ((name (gensym)))
-      (eval `(define-constant ,name "FOO" :test 'equal))
-      (eval `(define-constant ,name "FOO" :test 'equal))
-      (values (equal "FOO" (symbol-value name))
-              (constantp name)))
-  t
-  t)
-
-(deftest define-constant.2
-    (let ((name (gensym)))
-      (eval `(define-constant ,name 13))
-      (eval `(define-constant ,name 13))
-      (values (eql 13 (symbol-value name))
-              (constantp name)))
-  t
-  t)
-
-;;;; Errors
-
-;;; TYPEP is specified to return a generalized boolean and, for
-;;; example, ECL exploits this by returning the superclasses of ERROR
-;;; in this case.
-(defun errorp (x)
-  (not (null (typep x 'error))))
-
-(deftest required-argument.1
-    (multiple-value-bind (res err)
-        (ignore-errors (required-argument))
-      (errorp err))
-  t)
-
-;;;; Hash tables
-
-(deftest ensure-gethash.1
-    (let ((table (make-hash-table))
-          (x (list 1)))
-      (multiple-value-bind (value already-there)
-          (ensure-gethash x table 42)
-        (and (= value 42)
-             (not already-there)
-             (= 42 (gethash x table))
-             (multiple-value-bind (value2 already-there2)
-                 (ensure-gethash x table 13)
-               (and (= value2 42)
-                    already-there2
-                    (= 42 (gethash x table)))))))
-  t)
-
-(deftest ensure-gethash.2
-    (let ((table (make-hash-table))
-          (count 0))
-      (multiple-value-call #'values
-        (ensure-gethash (progn (incf count) :foo)
-                        (progn (incf count) table)
-                        (progn (incf count) :bar))
-        (gethash :foo table)
-        count))
-  :bar nil :bar t 3)
-
-(deftest copy-hash-table.1
-    (let ((orig (make-hash-table :test 'eq :size 123))
-          (foo "foo"))
-      (setf (gethash orig orig) t
-            (gethash foo orig) t)
-      (let ((eq-copy (copy-hash-table orig))
-            (eql-copy (copy-hash-table orig :test 'eql))
-            (equal-copy (copy-hash-table orig :test 'equal))
-            (equalp-copy (copy-hash-table orig :test 'equalp)))
-        (list (eql (hash-table-size eq-copy) (hash-table-size orig))
-              (eql (hash-table-rehash-size eq-copy)
-                   (hash-table-rehash-size orig))
-              (hash-table-count eql-copy)
-              (gethash orig eq-copy)
-              (gethash (copy-seq foo) eql-copy)
-              (gethash foo eql-copy)
-              (gethash (copy-seq foo) equal-copy)
-              (gethash "FOO" equal-copy)
-              (gethash "FOO" equalp-copy))))
-  (t t 2 t nil t t nil t))
-
-(deftest copy-hash-table.2
-    (let ((ht (make-hash-table))
-          (list (list :list (vector :A :B :C))))
-      (setf (gethash 'list ht) list)
-      (let* ((shallow-copy (copy-hash-table ht))
-             (deep1-copy (copy-hash-table ht :key 'copy-list))
-             (list         (gethash 'list ht))
-             (shallow-list (gethash 'list shallow-copy))
-             (deep1-list   (gethash 'list deep1-copy)))
-        (list (eq ht shallow-copy)
-              (eq ht deep1-copy)
-              (eq list shallow-list)
-              (eq list deep1-list)                   ; outer list was copied.
-              (eq (second list) (second shallow-list))
-              (eq (second list) (second deep1-list)) ; inner vector wasn't copied.
-              )))
-  (nil nil t nil t t))
-
-(deftest maphash-keys.1
-    (let ((keys nil)
-          (table (make-hash-table)))
-      (declare (notinline maphash-keys))
-      (dotimes (i 10)
-        (setf (gethash i table) t))
-      (maphash-keys (lambda (k) (push k keys)) table)
-      (set-equal keys '(0 1 2 3 4 5 6 7 8 9)))
-  t)
-
-(deftest maphash-values.1
-    (let ((vals nil)
-          (table (make-hash-table)))
-      (declare (notinline maphash-values))
-      (dotimes (i 10)
-        (setf (gethash i table) (- i)))
-      (maphash-values (lambda (v) (push v vals)) table)
-      (set-equal vals '(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)))
-  t)
-
-(deftest hash-table-keys.1
-    (let ((table (make-hash-table)))
-      (dotimes (i 10)
-        (setf (gethash i table) t))
-      (set-equal (hash-table-keys table) '(0 1 2 3 4 5 6 7 8 9)))
-  t)
-
-(deftest hash-table-values.1
-    (let ((table (make-hash-table)))
-      (dotimes (i 10)
-        (setf (gethash (gensym) table) i))
-      (set-equal (hash-table-values table) '(0 1 2 3 4 5 6 7 8 9)))
-  t)
-
-(deftest hash-table-alist.1
-    (let ((table (make-hash-table)))
-      (dotimes (i 10)
-        (setf (gethash i table) (- i)))
-      (let ((alist (hash-table-alist table)))
-        (list (length alist)
-              (assoc 0 alist)
-              (assoc 3 alist)
-              (assoc 9 alist)
-              (assoc nil alist))))
-  (10 (0 . 0) (3 . -3) (9 . -9) nil))
-
-(deftest hash-table-plist.1
-    (let ((table (make-hash-table)))
-      (dotimes (i 10)
-        (setf (gethash i table) (- i)))
-      (let ((plist (hash-table-plist table)))
-        (list (length plist)
-              (getf plist 0)
-              (getf plist 2)
-              (getf plist 7)
-              (getf plist nil))))
-  (20 0 -2 -7 nil))
-
-(deftest alist-hash-table.1
-    (let* ((alist '((0 a) (1 b) (2 c)))
-           (table (alist-hash-table alist)))
-      (list (hash-table-count table)
-            (gethash 0 table)
-            (gethash 1 table)
-            (gethash 2 table)
-            (eq (hash-table-test-name 'eql)
-                (hash-table-test table))))
-  (3 (a) (b) (c) t))
-
-(deftest alist-hash-table.duplicate-keys
-    (let* ((alist '((0 a) (1 b) (0 c) (1 d) (2 e)))
-           (table (alist-hash-table alist)))
-      (list (hash-table-count table)
-            (gethash 0 table)
-            (gethash 1 table)
-            (gethash 2 table)))
-  (3 (a) (b) (e)))
-
-(deftest plist-hash-table.1
-    (let* ((plist '(:a 1 :b 2 :c 3))
-           (table (plist-hash-table plist :test 'eq)))
-      (list (hash-table-count table)
-            (gethash :a table)
-            (gethash :b table)
-            (gethash :c table)
-            (gethash 2 table)
-            (gethash nil table)
-            (eq (hash-table-test-name 'eq)
-                (hash-table-test table))))
-  (3 1 2 3 nil nil t))
-
-(deftest plist-hash-table.duplicate-keys
-    (let* ((plist '(:a 1 :b 2 :a 3 :b 4 :c 5))
-           (table (plist-hash-table plist)))
-      (list (hash-table-count table)
-            (gethash :a table)
-            (gethash :b table)
-            (gethash :c table)))
-  (3 1 2 5))
-
-;;;; Functions
-
-(deftest disjoin.1
-    (let ((disjunction (disjoin (lambda (x)
-                                  (and (consp x) :cons))
-                                (lambda (x)
-                                  (and (stringp x) :string)))))
-      (list (funcall disjunction 'zot)
-            (funcall disjunction '(foo bar))
-            (funcall disjunction "test")))
-  (nil :cons :string))
-
-(deftest disjoin.2
-    (let ((disjunction (disjoin #'zerop)))
-      (list (funcall disjunction 0)
-            (funcall disjunction 1)))
-  (t nil))
-
-(deftest conjoin.1
-    (let ((conjunction (conjoin #'consp
-                                (lambda (x)
-                                  (stringp (car x)))
-                                (lambda (x)
-                                  (char (car x) 0)))))
-      (list (funcall conjunction 'zot)
-            (funcall conjunction '(foo))
-            (funcall conjunction '("foo"))))
-  (nil nil #\f))
-
-(deftest conjoin.2
-    (let ((conjunction (conjoin #'zerop)))
-      (list (funcall conjunction 0)
-            (funcall conjunction 1)))
-  (t nil))
-
-(deftest compose.1
-    (let ((composite (compose '1+
-                              (lambda (x)
-                                (* x 2))
-                              #'read-from-string)))
-      (funcall composite "1"))
-  3)
-
-(deftest compose.2
-    (let ((composite
-           (locally (declare (notinline compose))
-             (compose '1+
-                      (lambda (x)
-                        (* x 2))
-                      #'read-from-string))))
-      (funcall composite "2"))
-  5)
-
-(deftest compose.3
-    (let ((compose-form (funcall (compiler-macro-function 'compose)
-                                 '(compose '1+
-                                   (lambda (x)
-                                     (* x 2))
-                                   #'read-from-string)
-                                 nil)))
-      (let ((fun (funcall (compile nil `(lambda () ,compose-form)))))
-        (funcall fun "3")))
-  7)
-
-(deftest compose.4
-    (let ((composite (compose #'zerop)))
-      (list (funcall composite 0)
-            (funcall composite 1)))
-  (t nil))
-
-(deftest multiple-value-compose.1
-    (let ((composite (multiple-value-compose
-                      #'truncate
-                      (lambda (x y)
-                        (values y x))
-                      (lambda (x)
-                        (with-input-from-string (s x)
-                          (values (read s) (read s)))))))
-      (multiple-value-list (funcall composite "2 7")))
-  (3 1))
-
-(deftest multiple-value-compose.2
-    (let ((composite (locally (declare (notinline multiple-value-compose))
-                       (multiple-value-compose
-                        #'truncate
-                        (lambda (x y)
-                          (values y x))
-                       (lambda (x)
-                         (with-input-from-string (s x)
-                           (values (read s) (read s))))))))
-      (multiple-value-list (funcall composite "2 11")))
-  (5 1))
-
-(deftest multiple-value-compose.3
-    (let ((compose-form (funcall (compiler-macro-function 'multiple-value-compose)
-                                 '(multiple-value-compose
-                                   #'truncate
-                                   (lambda (x y)
-                                     (values y x))
-                                   (lambda (x)
-                                     (with-input-from-string (s x)
-                                       (values (read s) (read s)))))
-                                 nil)))
-      (let ((fun (funcall (compile nil `(lambda () ,compose-form)))))
-        (multiple-value-list (funcall fun "2 9"))))
-  (4 1))
-
-(deftest multiple-value-compose.4
-    (let ((composite (multiple-value-compose #'truncate)))
-      (multiple-value-list (funcall composite 9 2)))
-  (4 1))
-
-(deftest curry.1
-    (let ((curried (curry '+ 3)))
-      (funcall curried 1 5))
-  9)
-
-(deftest curry.2
-    (let ((curried (locally (declare (notinline curry))
-                     (curry '* 2 3))))
-      (funcall curried 7))
-  42)
-
-(deftest curry.3
-    (let ((curried-form (funcall (compiler-macro-function 'curry)
-                                 '(curry '/ 8)
-                                 nil)))
-      (let ((fun (funcall (compile nil `(lambda () ,curried-form)))))
-        (funcall fun 2)))
-  4)
-
-(deftest curry.4
-    (let* ((x 1)
-           (curried (curry (progn
-                             (incf x)
-                             (lambda (y z) (* x y z)))
-                           3)))
-      (list (funcall curried 7)
-            (funcall curried 7)
-            x))
-  (42 42 2))
-
-(deftest rcurry.1
-    (let ((r (rcurry '/ 2)))
-      (funcall r 8))
-  4)
-
-(deftest rcurry.2
-    (let* ((x 1)
-           (curried (rcurry (progn
-                              (incf x)
-                              (lambda (y z) (* x y z)))
-                            3)))
-      (list (funcall curried 7)
-            (funcall curried 7)
-            x))
-  (42 42 2))
-
-(deftest named-lambda.1
-    (let ((fac (named-lambda fac (x)
-                 (if (> x 1)
-                     (* x (fac (- x 1)))
-                     x))))
-      (funcall fac 5))
-  120)
-
-(deftest named-lambda.2
-    (let ((fac (named-lambda fac (&key x)
-                 (if (> x 1)
-                     (* x (fac :x (- x 1)))
-                     x))))
-      (funcall fac :x 5))
-  120)
-
-;;;; Lists
-
-(deftest alist-plist.1
-    (alist-plist '((a . 1) (b . 2) (c . 3)))
-  (a 1 b 2 c 3))
-
-(deftest plist-alist.1
-    (plist-alist '(a 1 b 2 c 3))
-  ((a . 1) (b . 2) (c . 3)))
-
-(deftest unionf.1
-    (let* ((list (list 1 2 3))
-           (orig list))
-      (unionf list (list 1 2 4))
-      (values (equal orig (list 1 2 3))
-              (eql (length list) 4)
-              (set-difference list (list 1 2 3 4))
-              (set-difference (list 1 2 3 4) list)))
-  t
-  t
-  nil
-  nil)
-
-(deftest nunionf.1
-    (let ((list (list 1 2 3)))
-      (nunionf list (list 1 2 4))
-      (values (eql (length list) 4)
-              (set-difference (list 1 2 3 4) list)
-              (set-difference list (list 1 2 3 4))))
-  t
-  nil
-  nil)
-
-(deftest appendf.1
-    (let* ((list (list 1 2 3))
-           (orig list))
-      (appendf list '(4 5 6) '(7 8))
-      (list list (eq list orig)))
-  ((1 2 3 4 5 6 7 8) nil))
-
-(deftest nconcf.1
-    (let ((list1 (list 1 2 3))
-          (list2 (list 4 5 6)))
-      (nconcf list1 list2 (list 7 8 9))
-      list1)
-  (1 2 3 4 5 6 7 8 9))
-
-(deftest circular-list.1
-    (let ((circle (circular-list 1 2 3)))
-      (list (first circle)
-            (second circle)
-            (third circle)
-            (fourth circle)
-            (eq circle (nthcdr 3 circle))))
-  (1 2 3 1 t))
-
-(deftest circular-list-p.1
-    (let* ((circle (circular-list 1 2 3 4))
-           (tree (list circle circle))
-           (dotted (cons circle t))
-           (proper (list 1 2 3 circle))
-           (tailcirc (list* 1 2 3 circle)))
-      (list (circular-list-p circle)
-            (circular-list-p tree)
-            (circular-list-p dotted)
-            (circular-list-p proper)
-            (circular-list-p tailcirc)))
-  (t nil nil nil t))
-
-(deftest circular-list-p.2
-    (circular-list-p 'foo)
-  nil)
-
-(deftest circular-tree-p.1
-    (let* ((circle (circular-list 1 2 3 4))
-           (tree1 (list circle circle))
-           (tree2 (let* ((level2 (list 1 nil 2))
-                         (level1 (list level2)))
-                    (setf (second level2) level1)
-                    level1))
-           (dotted (cons circle t))
-           (proper (list 1 2 3 circle))
-           (tailcirc (list* 1 2 3 circle))
-           (quite-proper (list 1 2 3))
-           (quite-dotted (list 1 (cons 2 3))))
-      (list (circular-tree-p circle)
-            (circular-tree-p tree1)
-            (circular-tree-p tree2)
-            (circular-tree-p dotted)
-            (circular-tree-p proper)
-            (circular-tree-p tailcirc)
-            (circular-tree-p quite-proper)
-            (circular-tree-p quite-dotted)))
-  (t t t t t t nil nil))
-
-(deftest circular-tree-p.2
-    (alexandria:circular-tree-p '#1=(#1#))
-  t)
-
-(deftest proper-list-p.1
-    (let ((l1 (list 1))
-          (l2 (list 1 2))
-          (l3 (cons 1 2))
-          (l4 (list (cons 1 2) 3))
-          (l5 (circular-list 1 2)))
-      (list (proper-list-p l1)
-            (proper-list-p l2)
-            (proper-list-p l3)
-            (proper-list-p l4)
-            (proper-list-p l5)))
-  (t t nil t nil))
-
-(deftest proper-list-p.2
-    (proper-list-p '(1 2 . 3))
-  nil)
-
-(deftest proper-list.type.1
-    (let ((l1 (list 1))
-          (l2 (list 1 2))
-          (l3 (cons 1 2))
-          (l4 (list (cons 1 2) 3))
-          (l5 (circular-list 1 2)))
-      (list (typep l1 'proper-list)
-            (typep l2 'proper-list)
-            (typep l3 'proper-list)
-            (typep l4 'proper-list)
-            (typep l5 'proper-list)))
-  (t t nil t nil))
-
-(deftest proper-list-length.1
-    (values
-     (proper-list-length nil)
-     (proper-list-length (list 1))
-     (proper-list-length (list 2 2))
-     (proper-list-length (list 3 3 3))
-     (proper-list-length (list 4 4 4 4))
-     (proper-list-length (list 5 5 5 5 5))
-     (proper-list-length (list 6 6 6 6 6 6))
-     (proper-list-length (list 7 7 7 7 7 7 7))
-     (proper-list-length (list 8 8 8 8 8 8 8 8))
-     (proper-list-length (list 9 9 9 9 9 9 9 9 9)))
-  0 1 2 3 4 5 6 7 8 9)
-
-(deftest proper-list-length.2
-    (flet ((plength (x)
-             (handler-case
-                 (proper-list-length x)
-               (type-error ()
-                 :ok))))
-      (values
-       (plength (list* 1))
-       (plength (list* 2 2))
-       (plength (list* 3 3 3))
-       (plength (list* 4 4 4 4))
-       (plength (list* 5 5 5 5 5))
-       (plength (list* 6 6 6 6 6 6))
-       (plength (list* 7 7 7 7 7 7 7))
-       (plength (list* 8 8 8 8 8 8 8 8))
-       (plength (list* 9 9 9 9 9 9 9 9 9))))
-  :ok :ok :ok
-  :ok :ok :ok
-  :ok :ok :ok)
-
-(deftest lastcar.1
-    (let ((l1 (list 1))
-          (l2 (list 1 2)))
-      (list (lastcar l1)
-            (lastcar l2)))
-  (1 2))
-
-(deftest lastcar.error.2
-    (handler-case
-        (progn
-          (lastcar (circular-list 1 2 3))
-          nil)
-      (error ()
-        t))
-  t)
-
-(deftest setf-lastcar.1
-    (let ((l (list 1 2 3 4)))
-      (values (lastcar l)
-              (progn
-                (setf (lastcar l) 42)
-                (lastcar l))))
-  4
-  42)
-
-(deftest setf-lastcar.2
-    (let ((l (circular-list 1 2 3)))
-      (multiple-value-bind (res err)
-          (ignore-errors (setf (lastcar l) 4))
-        (typep err 'type-error)))
-  t)
-
-(deftest make-circular-list.1
-    (let ((l (make-circular-list 3 :initial-element :x)))
-      (setf (car l) :y)
-      (list (eq l (nthcdr 3 l))
-            (first l)
-            (second l)
-            (third l)
-            (fourth l)))
-  (t :y :x :x :y))
-
-(deftest circular-list.type.1
-    (let* ((l1 (list 1 2 3))
-           (l2 (circular-list 1 2 3))
-           (l3 (list* 1 2 3 l2)))
-      (list (typep l1 'circular-list)
-            (typep l2 'circular-list)
-            (typep l3 'circular-list)))
-  (nil t t))
-
-(deftest ensure-list.1
-    (let ((x (list 1))
-          (y 2))
-      (list (ensure-list x)
-            (ensure-list y)))
-  ((1) (2)))
-
-(deftest ensure-cons.1
-    (let ((x (cons 1 2))
-          (y nil)
-          (z "foo"))
-      (values (ensure-cons x)
-              (ensure-cons y)
-              (ensure-cons z)))
-  (1 . 2)
-  (nil)
-  ("foo"))
-
-(deftest setp.1
-    (setp '(1))
-  t)
-
-(deftest setp.2
-    (setp nil)
-  t)
-
-(deftest setp.3
-    (setp "foo")
-  nil)
-
-(deftest setp.4
-    (setp '(1 2 3 1))
-  nil)
-
-(deftest setp.5
-    (setp '(1 2 3))
-  t)
-
-(deftest setp.6
-    (setp '(a :a))
-  t)
-
-(deftest setp.7
-    (setp '(a :a) :key 'character)
-  nil)
-
-(deftest setp.8
-    (setp '(a :a) :key 'character :test (constantly nil))
-  t)
-
-(deftest set-equal.1
-    (set-equal '(1 2 3) '(3 1 2))
-  t)
-
-(deftest set-equal.2
-    (set-equal '("Xa") '("Xb")
-               :test (lambda (a b) (eql (char a 0) (char b 0))))
-  t)
-
-(deftest set-equal.3
-    (set-equal '(1 2) '(4 2))
-  nil)
-
-(deftest set-equal.4
-    (set-equal '(a b c) '(:a :b :c) :key 'string :test 'equal)
-  t)
-
-(deftest set-equal.5
-    (set-equal '(a d c) '(:a :b :c) :key 'string :test 'equal)
-  nil)
-
-(deftest set-equal.6
-    (set-equal '(a b c) '(a b c d))
-  nil)
-
-(deftest map-product.1
-    (map-product 'cons '(2 3) '(1 4))
-  ((2 . 1) (2 . 4) (3 . 1) (3 . 4)))
-
-(deftest map-product.2
-    (map-product #'cons '(2 3) '(1 4))
-  ((2 . 1) (2 . 4) (3 . 1) (3 . 4)))
-
-(deftest flatten.1
-    (flatten '((1) 2 (((3 4))) ((((5)) 6)) 7))
-  (1 2 3 4 5 6 7))
-
-(deftest remove-from-plist.1
-    (let ((orig '(a 1 b 2 c 3 d 4)))
-      (list (remove-from-plist orig 'a 'c)
-            (remove-from-plist orig 'b 'd)
-            (remove-from-plist orig 'b)
-            (remove-from-plist orig 'a)
-            (remove-from-plist orig 'd 42 "zot")
-            (remove-from-plist orig 'a 'b 'c 'd)
-            (remove-from-plist orig 'a 'b 'c 'd 'x)
-            (equal orig '(a 1 b 2 c 3 d 4))))
-  ((b 2 d 4)
-   (a 1 c 3)
-   (a 1 c 3 d 4)
-   (b 2 c 3 d 4)
-   (a 1 b 2 c 3)
-   nil
-   nil
-   t))
-
-(deftest delete-from-plist.1
-    (let ((orig '(a 1 b 2 c 3 d 4 d 5)))
-      (list (delete-from-plist (copy-list orig) 'a 'c)
-            (delete-from-plist (copy-list orig) 'b 'd)
-            (delete-from-plist (copy-list orig) 'b)
-            (delete-from-plist (copy-list orig) 'a)
-            (delete-from-plist (copy-list orig) 'd 42 "zot")
-            (delete-from-plist (copy-list orig) 'a 'b 'c 'd)
-            (delete-from-plist (copy-list orig) 'a 'b 'c 'd 'x)
-            (equal orig (delete-from-plist orig))
-            (eq orig (delete-from-plist orig))))
-  ((b 2 d 4 d 5)
-   (a 1 c 3)
-   (a 1 c 3 d 4 d 5)
-   (b 2 c 3 d 4 d 5)
-   (a 1 b 2 c 3)
-   nil
-   nil
-   t
-   t))
-
-(deftest mappend.1
-    (mappend (compose 'list '*) '(1 2 3) '(1 2 3))
-  (1 4 9))
-
-(deftest assoc-value.1
-    (let ((key1 '(complex key))
-          (key2 'simple-key)
-          (alist '())
-          (result '()))
-      (push 1 (assoc-value alist key1 :test #'equal))
-      (push 2 (assoc-value alist key1 :test 'equal))
-      (push 42 (assoc-value alist key2))
-      (push 43 (assoc-value alist key2 :test 'eq))
-      (push (assoc-value alist key1 :test #'equal) result)
-      (push (assoc-value alist key2) result)
-
-      (push 'very (rassoc-value alist (list 2 1) :test #'equal))
-      (push (cdr (assoc '(very complex key) alist :test #'equal)) result)
-      result)
-  ((2 1) (43 42) (2 1)))
-
-;;;; Numbers
-
-(deftest clamp.1
-    (list (clamp 1.5 1 2)
-          (clamp 2.0 1 2)
-          (clamp 1.0 1 2)
-          (clamp 3 1 2)
-          (clamp 0 1 2))
-  (1.5 2.0 1.0 2 1))
-
-(deftest gaussian-random.1
-    (let ((min -0.2)
-          (max +0.2))
-      (multiple-value-bind (g1 g2)
-          (gaussian-random min max)
-        (values (<= min g1 max)
-                (<= min g2 max)
-                (/= g1 g2) ;uh
-                )))
-  t
-  t
-  t)
-
-#+sbcl
-(deftest gaussian-random.2
-    (handler-case
-        (sb-ext:with-timeout 2
-          (progn
-            (loop
-              :repeat 10000
-              :do (gaussian-random 0 nil))
-            'done))
-      (sb-ext:timeout ()
-        'timed-out))
-  done)
-
-(deftest iota.1
-    (iota 3)
-  (0 1 2))
-
-(deftest iota.2
-    (iota 3 :start 0.0d0)
-  (0.0d0 1.0d0 2.0d0))
-
-(deftest iota.3
-    (iota 3 :start 2 :step 3.0)
-  (2.0 5.0 8.0))
-
-(deftest map-iota.1
-    (let (all)
-      (declare (notinline map-iota))
-      (values (map-iota (lambda (x) (push x all))
-                        3
-                        :start 2
-                        :step 1.1d0)
-              all))
-  3
-  (4.2d0 3.1d0 2.0d0))
-
-(deftest lerp.1
-    (lerp 0.5 1 2)
-  1.5)
-
-(deftest lerp.2
-    (lerp 0.1 1 2)
-  1.1)
-
-(deftest lerp.3
-    (lerp 0.1 4 25)
-  6.1)
-
-(deftest mean.1
-    (mean '(1 2 3))
-  2)
-
-(deftest mean.2
-    (mean '(1 2 3 4))
-  5/2)
-
-(deftest mean.3
-    (mean '(1 2 10))
-  13/3)
-
-(deftest median.1
-    (median '(100 0 99 1 98 2 97))
-  97)
-
-(deftest median.2
-    (median '(100 0 99 1 98 2 97 96))
-  193/2)
-
-(deftest variance.1
-    (variance (list 1 2 3))
-  2/3)
-
-(deftest standard-deviation.1
-    (< 0 (standard-deviation (list 1 2 3)) 1)
-  t)
-
-(deftest maxf.1
-    (let ((x 1))
-      (maxf x 2)
-      x)
-  2)
-
-(deftest maxf.2
-    (let ((x 1))
-      (maxf x 0)
-      x)
-  1)
-
-(deftest maxf.3
-    (let ((x 1)
-          (c 0))
-      (maxf x (incf c))
-      (list x c))
-  (1 1))
-
-(deftest maxf.4
-    (let ((xv (vector 0 0 0))
-          (p 0))
-      (maxf (svref xv (incf p)) (incf p))
-      (list p xv))
-  (2 #(0 2 0)))
-
-(deftest minf.1
-    (let ((y 1))
-      (minf y 0)
-      y)
-  0)
-
-(deftest minf.2
-    (let ((xv (vector 10 10 10))
-          (p 0))
-      (minf (svref xv (incf p)) (incf p))
-      (list p xv))
-  (2 #(10 2 10)))
-
-(deftest subfactorial.1
-    (mapcar #'subfactorial (iota 22))
-  (1
-   0
-   1
-   2
-   9
-   44
-   265
-   1854
-   14833
-   133496
-   1334961
-   14684570
-   176214841
-   2290792932
-   32071101049
-   481066515734
-   7697064251745
-   130850092279664
-   2355301661033953
-   44750731559645106
-   895014631192902121
-   18795307255050944540))
-
-;;;; Arrays
-
-#+nil
-(deftest array-index.type)
-
-#+nil
-(deftest copy-array)
-
-;;;; Sequences
-
-(deftest rotate.1
-    (list (rotate (list 1 2 3) 0)
-          (rotate (list 1 2 3) 1)
-          (rotate (list 1 2 3) 2)
-          (rotate (list 1 2 3) 3)
-          (rotate (list 1 2 3) 4))
-  ((1 2 3)
-   (3 1 2)
-   (2 3 1)
-   (1 2 3)
-   (3 1 2)))
-
-(deftest rotate.2
-    (list (rotate (vector 1 2 3 4) 0)
-          (rotate (vector 1 2 3 4))
-          (rotate (vector 1 2 3 4) 2)
-          (rotate (vector 1 2 3 4) 3)
-          (rotate (vector 1 2 3 4) 4)
-          (rotate (vector 1 2 3 4) 5))
-  (#(1 2 3 4)
-    #(4 1 2 3)
-    #(3 4 1 2)
-    #(2 3 4 1)
-    #(1 2 3 4)
-    #(4 1 2 3)))
-
-(deftest rotate.3
-    (list (rotate (list 1 2 3) 0)
-          (rotate (list 1 2 3) -1)
-          (rotate (list 1 2 3) -2)
-          (rotate (list 1 2 3) -3)
-          (rotate (list 1 2 3) -4))
-  ((1 2 3)
-   (2 3 1)
-   (3 1 2)
-   (1 2 3)
-   (2 3 1)))
-
-(deftest rotate.4
-    (list (rotate (vector 1 2 3 4) 0)
-          (rotate (vector 1 2 3 4) -1)
-          (rotate (vector 1 2 3 4) -2)
-          (rotate (vector 1 2 3 4) -3)
-          (rotate (vector 1 2 3 4) -4)
-          (rotate (vector 1 2 3 4) -5))
-  (#(1 2 3 4)
-   #(2 3 4 1)
-   #(3 4 1 2)
-   #(4 1 2 3)
-   #(1 2 3 4)
-   #(2 3 4 1)))
-
-(deftest rotate.5
-    (values (rotate (list 1) 17)
-            (rotate (list 1) -5))
-  (1)
-  (1))
-
-(deftest shuffle.1
-    (let ((s (shuffle (iota 100))))
-      (list (equal s (iota 100))
-            (every (lambda (x)
-                     (member x s))
-                   (iota 100))
-            (every (lambda (x)
-                     (typep x '(integer 0 99)))
-                   s)))
-  (nil t t))
-
-(deftest shuffle.2
-    (let ((s (shuffle (coerce (iota 100) 'vector))))
-      (list (equal s (coerce (iota 100) 'vector))
-            (every (lambda (x)
-                     (find x s))
-                   (iota 100))
-            (every (lambda (x)
-                     (typep x '(integer 0 99)))
-                   s)))
-  (nil t t))
-
-(deftest shuffle.3
-    (let* ((orig (coerce (iota 21) 'vector))
-           (copy (copy-seq orig)))
-      (shuffle copy :start 10 :end 15)
-      (list (every #'eql (subseq copy 0 10) (subseq orig 0 10))
-            (every #'eql (subseq copy 15) (subseq orig 15))))
-  (t t))
-
-(deftest random-elt.1
-    (let ((s1 #(1 2 3 4))
-          (s2 '(1 2 3 4)))
-      (list (dotimes (i 1000 nil)
-              (unless (member (random-elt s1) s2)
-                (return nil))
-              (when (/= (random-elt s1) (random-elt s1))
-                (return t)))
-            (dotimes (i 1000 nil)
-              (unless (member (random-elt s2) s2)
-                (return nil))
-              (when (/= (random-elt s2) (random-elt s2))
-                (return t)))))
-  (t t))
-
-(deftest removef.1
-    (let* ((x '(1 2 3))
-           (x* x)
-           (y #(1 2 3))
-           (y* y))
-      (removef x 1)
-      (removef y 3)
-      (list x x* y y*))
-  ((2 3)
-   (1 2 3)
-   #(1 2)
-   #(1 2 3)))
-
-(deftest deletef.1
-    (let* ((x (list 1 2 3))
-           (x* x)
-           (y (vector 1 2 3)))
-      (deletef x 2)
-      (deletef y 1)
-      (list x x* y))
-  ((1 3)
-   (1 3)
-   #(2 3)))
-
-(deftest map-permutations.1
-    (let ((seq (list 1 2 3))
-          (seen nil)
-          (ok t))
-      (map-permutations (lambda (s)
-                          (unless (set-equal s seq)
-                            (setf ok nil))
-                          (when (member s seen :test 'equal)
-                            (setf ok nil))
-                          (push s seen))
-                        seq
-                        :copy t)
-      (values ok (length seen)))
-  t
-  6)
-
-(deftest proper-sequence.type.1
-    (mapcar (lambda (x)
-              (typep x 'proper-sequence))
-            (list (list 1 2 3)
-                  (vector 1 2 3)
-                  #2a((1 2) (3 4))
-                  (circular-list 1 2 3 4)))
-  (t t nil nil))
-
-(deftest emptyp.1
-    (mapcar #'emptyp
-            (list (list 1)
-                  (circular-list 1)
-                  nil
-                  (vector)
-                  (vector 1)))
-  (nil nil t t nil))
-
-(deftest sequence-of-length-p.1
-    (mapcar #'sequence-of-length-p
-            (list nil
-                  #()
-                  (list 1)
-                  (vector 1)
-                  (list 1 2)
-                  (vector 1 2)
-                  (list 1 2)
-                  (vector 1 2)
-                  (list 1 2)
-                  (vector 1 2))
-            (list 0
-                  0
-                  1
-                  1
-                  2
-                  2
-                  1
-                  1
-                  4
-                  4))
-  (t t t t t t nil nil nil nil))
-
-(deftest length=.1
-    (mapcar #'length=
-            (list nil
-                  #()
-                  (list 1)
-                  (vector 1)
-                  (list 1 2)
-                  (vector 1 2)
-                  (list 1 2)
-                  (vector 1 2)
-                  (list 1 2)
-                  (vector 1 2))
-            (list 0
-                  0
-                  1
-                  1
-                  2
-                  2
-                  1
-                  1
-                  4
-                  4))
-  (t t t t t t nil nil nil nil))
-
-(deftest length=.2
-    ;; test the compiler macro
-    (macrolet ((x (&rest args)
-                 (funcall
-                  (compile nil
-                           `(lambda ()
-                              (length= ,@args))))))
-      (list (x 2 '(1 2))
-            (x '(1 2) '(3 4))
-            (x '(1 2) 2)
-            (x '(1 2) 2 '(3 4))
-            (x 1 2 3)))
-  (t t t t nil))
-
-(deftest copy-sequence.1
-    (let ((l (list 1 2 3))
-          (v (vector #\a #\b #\c)))
-      (declare (notinline copy-sequence))
-      (let ((l.list (copy-sequence 'list l))
-            (l.vector (copy-sequence 'vector l))
-            (l.spec-v (copy-sequence '(vector fixnum) l))
-            (v.vector (copy-sequence 'vector v))
-            (v.list (copy-sequence 'list v))
-            (v.string (copy-sequence 'string v)))
-        (list (member l (list l.list l.vector l.spec-v))
-              (member v (list v.vector v.list v.string))
-              (equal l.list l)
-              (equalp l.vector #(1 2 3))
-              (type= (upgraded-array-element-type 'fixnum)
-                     (array-element-type l.spec-v))
-              (equalp v.vector v)
-              (equal v.list '(#\a #\b #\c))
-              (equal "abc" v.string))))
-  (nil nil t t t t t t))
-
-(deftest first-elt.1
-    (mapcar #'first-elt
-            (list (list 1 2 3)
-                  "abc"
-                  (vector :a :b :c)))
-  (1 #\a :a))
-
-(deftest first-elt.error.1
-    (mapcar (lambda (x)
-              (handler-case
-                  (first-elt x)
-                (type-error ()
-                  :type-error)))
-            (list nil
-                  #()
-                  12
-                  :zot))
-  (:type-error
-   :type-error
-   :type-error
-   :type-error))
-
-(deftest setf-first-elt.1
-    (let ((l (list 1 2 3))
-          (s (copy-seq "foobar"))
-          (v (vector :a :b :c)))
-      (setf (first-elt l) -1
-            (first-elt s) #\x
-            (first-elt v) 'zot)
-      (values l s v))
-  (-1 2 3)
-  "xoobar"
-  #(zot :b :c))
-
-(deftest setf-first-elt.error.1
-    (let ((l 'foo))
-      (multiple-value-bind (res err)
-          (ignore-errors (setf (first-elt l) 4))
-        (typep err 'type-error)))
-  t)
-
-(deftest last-elt.1
-    (mapcar #'last-elt
-            (list (list 1 2 3)
-                  (vector :a :b :c)
-                  "FOOBAR"
-                  #*001
-                  #*010))
-  (3 :c #\R 1 0))
-
-(deftest last-elt.error.1
-    (mapcar (lambda (x)
-              (handler-case
-                  (last-elt x)
-                (type-error ()
-                  :type-error)))
-            (list nil
-                  #()
-                  12
-                  :zot
-                  (circular-list 1 2 3)
-                  (list* 1 2 3 (circular-list 4 5))))
-  (:type-error
-   :type-error
-   :type-error
-   :type-error
-   :type-error
-   :type-error))
-
-(deftest setf-last-elt.1
-    (let ((l (list 1 2 3))
-          (s (copy-seq "foobar"))
-          (b (copy-seq #*010101001)))
-      (setf (last-elt l) '???
-            (last-elt s) #\?
-            (last-elt b) 0)
-      (values l s b))
-  (1 2 ???)
-  "fooba?"
-  #*010101000)
-
-(deftest setf-last-elt.error.1
-    (handler-case
-        (setf (last-elt 'foo) 13)
-      (type-error ()
-        :type-error))
-  :type-error)
-
-(deftest starts-with.1
-    (list (starts-with 1 '(1 2 3))
-          (starts-with 1 #(1 2 3))
-          (starts-with #\x "xyz")
-          (starts-with 2 '(1 2 3))
-          (starts-with 3 #(1 2 3))
-          (starts-with 1 1)
-          (starts-with nil nil))
-  (t t t nil nil nil nil))
-
-(deftest starts-with.2
-    (values (starts-with 1 '(-1 2 3) :key '-)
-            (starts-with "foo" '("foo" "bar") :test 'equal)
-            (starts-with "f" '(#\f) :key 'string :test 'equal)
-            (starts-with -1 '(0 1 2) :key #'1+)
-            (starts-with "zot" '("ZOT") :test 'equal))
-  t
-  t
-  t
-  nil
-  nil)
-
-(deftest ends-with.1
-    (list (ends-with 3 '(1 2 3))
-          (ends-with 3 #(1 2 3))
-          (ends-with #\z "xyz")
-          (ends-with 2 '(1 2 3))
-          (ends-with 1 #(1 2 3))
-          (ends-with 1 1)
-          (ends-with nil nil))
-  (t t t nil nil nil nil))
-
-(deftest ends-with.2
-    (values (ends-with 2 '(0 13 1) :key '1+)
-            (ends-with "foo" (vector "bar" "foo") :test 'equal)
-            (ends-with "X" (vector 1 2 #\X) :key 'string :test 'equal)
-            (ends-with "foo" "foo" :test 'equal))
-  t
-  t
-  t
-  nil)
-
-(deftest ends-with.error.1
-    (handler-case
-        (ends-with 3 (circular-list 3 3 3 1 3 3))
-      (type-error ()
-        :type-error))
-  :type-error)
-
-(deftest sequences.passing-improper-lists
-    (macrolet ((signals-error-p (form)
-                 `(handler-case
-                      (progn ,form nil)
-                    (type-error (e)
-                      t)))
-               (cut (fn &rest args)
-                 (with-gensyms (arg)
-                   (print`(lambda (,arg)
-                       (apply ,fn (list ,@(substitute arg '_ args))))))))
-      (let ((circular-list (make-circular-list 5 :initial-element :foo))
-            (dotted-list (list* 'a 'b 'c 'd)))
-        (loop for nth from 0
-              for fn in (list
-                         (cut #'lastcar _)
-                         (cut #'rotate _ 3)
-                         (cut #'rotate _ -3)
-                         (cut #'shuffle _)
-                         (cut #'random-elt _)
-                         (cut #'last-elt _)
-                         (cut #'ends-with :foo _))
-              nconcing
-                 (let ((on-circular-p (signals-error-p (funcall fn circular-list)))
-                       (on-dotted-p (signals-error-p (funcall fn dotted-list))))
-                   (when (or (not on-circular-p) (not on-dotted-p))
-                     (append
-                      (unless on-circular-p
-                        (let ((*print-circle* t))
-                          (list
-                           (format nil
-                                   "No appropriate error signalled when passing ~S to ~Ath entry."
-                                   circular-list nth))))
-                      (unless on-dotted-p
-                        (list
-                         (format nil
-                                 "No appropriate error signalled when passing ~S to ~Ath entry."
-                                 dotted-list nth)))))))))
-  nil)
-
-;;;; IO
-
-(deftest read-stream-content-into-string.1
-    (values (with-input-from-string (stream "foo bar")
-              (read-stream-content-into-string stream))
-            (with-input-from-string (stream "foo bar")
-              (read-stream-content-into-string stream :buffer-size 1))
-            (with-input-from-string (stream "foo bar")
-              (read-stream-content-into-string stream :buffer-size 6))
-            (with-input-from-string (stream "foo bar")
-              (read-stream-content-into-string stream :buffer-size 7)))
-  "foo bar"
-  "foo bar"
-  "foo bar"
-  "foo bar")
-
-(deftest read-stream-content-into-string.2
-    (handler-case
-        (let ((stream (make-broadcast-stream)))
-          (read-stream-content-into-string stream :buffer-size 0))
-      (type-error ()
-        :type-error))
-  :type-error)
-
-#+(or)
-(defvar *octets*
-  (map '(simple-array (unsigned-byte 8) (7)) #'char-code "foo bar"))
-
-#+(or)
-(deftest read-stream-content-into-byte-vector.1
-    (values (with-input-from-byte-vector (stream *octets*)
-              (read-stream-content-into-byte-vector stream))
-            (with-input-from-byte-vector (stream *octets*)
-              (read-stream-content-into-byte-vector stream :initial-size 1))
-            (with-input-from-byte-vector (stream *octets*)
-              (read-stream-content-into-byte-vector stream 'alexandria::%length 6))
-            (with-input-from-byte-vector (stream *octets*)
-              (read-stream-content-into-byte-vector stream 'alexandria::%length 3)))
-  *octets*
-  *octets*
-  *octets*
-  (subseq *octets* 0 3))
-
-(deftest read-stream-content-into-byte-vector.2
-    (handler-case
-        (let ((stream (make-broadcast-stream)))
-          (read-stream-content-into-byte-vector stream :initial-size 0))
-      (type-error ()
-        :type-error))
-  :type-error)
-
-;;;; Macros
-
-(deftest with-unique-names.1
-    (let ((*gensym-counter* 0))
-      (let ((syms (with-unique-names (foo bar quux)
-                    (list foo bar quux))))
-        (list (find-if #'symbol-package syms)
-              (equal '("FOO0" "BAR1" "QUUX2")
-                     (mapcar #'symbol-name syms)))))
-  (nil t))
-
-(deftest with-unique-names.2
-    (let ((*gensym-counter* 0))
-      (let ((syms (with-unique-names ((foo "_foo_") (bar -bar-) (quux #\q))
-                    (list foo bar quux))))
-        (list (find-if #'symbol-package syms)
-              (equal '("_foo_0" "-BAR-1" "q2")
-                     (mapcar #'symbol-name syms)))))
-  (nil t))
-
-(deftest with-unique-names.3
-    (let ((*gensym-counter* 0))
-      (multiple-value-bind (res err)
-          (ignore-errors
-            (eval
-             '(let ((syms
-                     (with-unique-names ((foo "_foo_") (bar -bar-) (quux 42))
-                       (list foo bar quux))))
-               (list (find-if #'symbol-package syms)
-                (equal '("_foo_0" "-BAR-1" "q2")
-                 (mapcar #'symbol-name syms))))))
-        (errorp err)))
-  t)
-
-(deftest once-only.1
-    (macrolet ((cons1.good (x)
-                 (once-only (x)
-                   `(cons ,x ,x)))
-               (cons1.bad (x)
-                 `(cons ,x ,x)))
-      (let ((y 0))
-        (list (cons1.good (incf y))
-              y
-              (cons1.bad (incf y))
-              y)))
-  ((1 . 1) 1 (2 . 3) 3))
-
-(deftest once-only.2
-    (macrolet ((cons1 (x)
-                 (once-only ((y x))
-                   `(cons ,y ,y))))
-      (let ((z 0))
-        (list (cons1 (incf z))
-              z
-              (cons1 (incf z)))))
-  ((1 . 1) 1 (2 . 2)))
-
-(deftest parse-body.1
-    (parse-body '("doc" "body") :documentation t)
-  ("body")
-  nil
-  "doc")
-
-(deftest parse-body.2
-    (parse-body '("body") :documentation t)
-  ("body")
-  nil
-  nil)
-
-(deftest parse-body.3
-    (parse-body '("doc" "body"))
-  ("doc" "body")
-  nil
-  nil)
-
-(deftest parse-body.4
-    (parse-body '((declare (foo)) "doc" (declare (bar)) body) :documentation t)
-  (body)
-  ((declare (foo)) (declare (bar)))
-  "doc")
-
-(deftest parse-body.5
-    (parse-body '((declare (foo)) "doc" (declare (bar)) body))
-  ("doc" (declare (bar)) body)
-  ((declare (foo)))
-  nil)
-
-(deftest parse-body.6
-    (multiple-value-bind (res err)
-        (ignore-errors
-          (parse-body '("foo" "bar" "quux")
-                      :documentation t))
-      (errorp err))
-  t)
-
-;;;; Symbols
-
-(deftest ensure-symbol.1
-    (ensure-symbol :cons :cl)
-  cons
-  :external)
-
-(deftest ensure-symbol.2
-    (ensure-symbol "CONS" :alexandria)
-  cons
-  :inherited)
-
-(deftest ensure-symbol.3
-    (ensure-symbol 'foo :keyword)
-  :foo
-  :external)
-
-(deftest ensure-symbol.4
-    (ensure-symbol #\* :alexandria)
-  *
-  :inherited)
-
-(deftest format-symbol.1
-    (let ((s (format-symbol nil '#:x-~d 13)))
-      (list (symbol-package s)
-            (string= (string '#:x-13) (symbol-name s))))
-  (nil t))
-
-(deftest format-symbol.2
-    (format-symbol :keyword '#:sym-~a (string :bolic))
-  :sym-bolic)
-
-(deftest format-symbol.3
-    (let ((*package* (find-package :cl)))
-      (format-symbol t '#:find-~a (string 'package)))
-  find-package)
-
-(deftest make-keyword.1
-    (list (make-keyword 'zot)
-          (make-keyword "FOO")
-          (make-keyword #\Q))
-  (:zot :foo :q))
-
-(deftest make-gensym-list.1
-    (let ((*gensym-counter* 0))
-      (let ((syms (make-gensym-list 3 "FOO")))
-        (list (find-if 'symbol-package syms)
-              (equal '("FOO0" "FOO1" "FOO2")
-                     (mapcar 'symbol-name syms)))))
-  (nil t))
-
-(deftest make-gensym-list.2
-    (let ((*gensym-counter* 0))
-      (let ((syms (make-gensym-list 3)))
-        (list (find-if 'symbol-package syms)
-              (equal '("G0" "G1" "G2")
-                     (mapcar 'symbol-name syms)))))
-  (nil t))
-
-;;;; Type-system
-
-(deftest of-type.1
-    (locally
-        (declare (notinline of-type))
-    (let ((f (of-type 'string)))
-      (list (funcall f "foo")
-            (funcall f 'bar))))
-  (t nil))
-
-(deftest type=.1
-    (type= 'string 'string)
-  t
-  t)
-
-(deftest type=.2
-    (type= 'list '(or null cons))
-  t
-  t)
-
-(deftest type=.3
-    (type= 'null '(and symbol list))
-  t
-  t)
-
-(deftest type=.4
-    (type= 'string '(satisfies emptyp))
-  nil
-  nil)
-
-(deftest type=.5
-    (type= 'string 'list)
-  nil
-  t)
-
-(macrolet
-    ((test (type numbers)
-       `(deftest ,(format-symbol t '#:cdr5.~a (string type))
-            (let ((numbers ,numbers))
-              (values (mapcar (of-type ',(format-symbol t '#:negative-~a (string type))) numbers)
-                      (mapcar (of-type ',(format-symbol t '#:non-positive-~a (string type))) numbers)
-                      (mapcar (of-type ',(format-symbol t '#:non-negative-~a (string type))) numbers)
-                      (mapcar (of-type ',(format-symbol t '#:positive-~a (string type))) numbers)))
-          (t t t nil nil nil nil)
-          (t t t t nil nil nil)
-          (nil nil nil t t t t)
-          (nil nil nil nil t t t))))
-  (test fixnum       (list most-negative-fixnum       -42      -1     0     1     42      most-positive-fixnum))
-  (test integer      (list (1- most-negative-fixnum)  -42      -1     0     1     42      (1+ most-positive-fixnum)))
-  (test rational     (list (1- most-negative-fixnum)  -42/13   -1     0     1     42/13   (1+ most-positive-fixnum)))
-  (test real         (list most-negative-long-float   -42/13   -1     0     1     42/13   most-positive-long-float))
-  (test float        (list most-negative-short-float  -42.02   -1.0   0.0   1.0   42.02   most-positive-short-float))
-  (test short-float  (list most-negative-short-float  -42.02s0 -1.0s0 0.0s0 1.0s0 42.02s0 most-positive-short-float))
-  (test single-float (list most-negative-single-float -42.02f0 -1.0f0 0.0f0 1.0f0 42.02f0 most-positive-single-float))
-  (test double-float (list most-negative-double-float -42.02d0 -1.0d0 0.0d0 1.0d0 42.02d0 most-positive-double-float))
-  (test long-float   (list most-negative-long-float   -42.02l0 -1.0l0 0.0l0 1.0l0 42.02l0 most-positive-long-float)))
-
-;;;; Bindings
-
-(declaim (notinline opaque))
-(defun opaque (x)
-  x)
-
-(deftest if-let.1
-    (if-let (x (opaque :ok))
-            x
-            :bad)
-  :ok)
-
-(deftest if-let.2
-    (if-let (x (opaque nil))
-            :bad
-            (and (not x) :ok))
-  :ok)
-
-(deftest if-let.3
-    (let ((x 1))
-      (if-let ((x 2)
-               (y x))
-              (+ x y)
-              :oops))
-  3)
-
-(deftest if-let.4
-    (if-let ((x 1)
-             (y nil))
-            :oops
-            (and (not y) x))
-  1)
-
-(deftest if-let.5
-    (if-let (x)
-            :oops
-            (not x))
-  t)
-
-(deftest if-let.error.1
-    (handler-case
-        (eval '(if-let x
-                :oops
-                :oops))
-      (type-error ()
-        :type-error))
-  :type-error)
-
-(deftest when-let.1
-    (when-let (x (opaque :ok))
-      (setf x (cons x x))
-      x)
-  (:ok . :ok))
-
-(deftest when-let.2
-    (when-let ((x 1)
-               (y nil)
-               (z 3))
-      :oops)
-  nil)
-
-(deftest when-let.3
-    (let ((x 1))
-      (when-let ((x 2)
-                 (y x))
-        (+ x y)))
-  3)
-
-(deftest when-let.error.1
-    (handler-case
-        (eval '(when-let x :oops))
-      (type-error ()
-        :type-error))
-  :type-error)
-
-(deftest when-let*.1
-    (let ((x 1))
-      (when-let* ((x 2)
-                  (y x))
-        (+ x y)))
-  4)
-
-(deftest when-let*.2
-    (let ((y 1))
-      (when-let* (x y)
-        (1+ x)))
-  2)
-
-(deftest when-let*.3
-    (when-let* ((x t)
-                (y (consp x))
-                (z (error "OOPS")))
-      t)
-  nil)
-
-(deftest when-let*.error.1
-    (handler-case
-        (eval '(when-let* x :oops))
-      (type-error ()
-        :type-error))
-  :type-error)
-
-(deftest doplist.1
-    (let (keys values)
-      (doplist (k v '(a 1 b 2 c 3) (values t (reverse keys) (reverse values) k v))
-        (push k keys)
-        (push v values)))
-  t
-  (a b c)
-  (1 2 3)
-  nil
-  nil)
-
-(deftest count-permutations.1
-    (values (count-permutations 31 7)
-            (count-permutations 1 1)
-            (count-permutations 2 1)
-            (count-permutations 2 2)
-            (count-permutations 3 2)
-            (count-permutations 3 1))
-  13253058000
-  1
-  2
-  2
-  6
-  3)
-
-(deftest binomial-coefficient.1
-    (alexandria:binomial-coefficient 1239 139)
-  28794902202288970200771694600561826718847179309929858835480006683522184441358211423695124921058123706380656375919763349913245306834194782172712255592710204598527867804110129489943080460154)
-
-;; Exercise bignum case (at least on x86).
-(deftest binomial-coefficient.2
-    (alexandria:binomial-coefficient 2000000000000 20)
-  430998041177272843950422879590338454856322722740402365741730748431530623813012487773080486408378680853987520854296499536311275320016878730999689934464711239072435565454954447356845336730100919970769793030177499999999900000000000)
-
-(deftest copy-stream.1
-    (let ((data "sdkfjhsakfh weior763495ewofhsdfk sdfadlkfjhsadf woif sdlkjfhslkdfh sdklfjh"))
-      (values (equal data
-                     (with-input-from-string (in data)
-                       (with-output-to-string (out)
-                         (alexandria:copy-stream in out))))
-              (equal (subseq data 10 20)
-                     (with-input-from-string (in data)
-                       (with-output-to-string (out)
-                         (alexandria:copy-stream in out :start 10 :end 20))))
-              (equal (subseq data 10)
-                     (with-input-from-string (in data)
-                       (with-output-to-string (out)
-                         (alexandria:copy-stream in out :start 10))))
-              (equal (subseq data 0 20)
-                     (with-input-from-string (in data)
-                       (with-output-to-string (out)
-                         (alexandria:copy-stream in out :end 20))))))
-  t
-  t
-  t
-  t)
-
-(deftest extremum.1
-    (let ((n 0))
-      (dotimes (i 10)
-       (let ((data (shuffle (coerce (iota 10000 :start i) 'vector)))
-             (ok t))
-         (unless (eql i (extremum data #'<))
-           (setf ok nil))
-         (unless (eql i (extremum (coerce data 'list) #'<))
-           (setf ok nil))
-         (unless (eql (+ 9999 i) (extremum data #'>))
-           (setf ok nil))
-         (unless (eql (+ 9999 i) (extremum (coerce  data 'list) #'>))
-           (setf ok nil))
-         (when ok
-           (incf n))))
-      (when (eql 10 (extremum #(100 1 10 1000) #'> :start 1 :end 3))
-        (incf n))
-      (when (eql -1000 (extremum #(100 1 10 -1000) #'> :key 'abs))
-        (incf n))
-      (when (eq nil (extremum "" (lambda (a b) (error "wtf? ~S, ~S" a b))))
-        (incf n))
-      n)
-  13)
-
-(deftest starts-with-subseq.string
-    (starts-with-subseq "f" "foo" :return-suffix t)
-  t
-  "oo")
-
-(deftest starts-with-subseq.vector
-    (starts-with-subseq #(1) #(1 2 3) :return-suffix t)
-  t
-  #(2 3))
-
-(deftest starts-with-subseq.list
-    (starts-with-subseq '(1) '(1 2 3) :return-suffix t)
-  t
-  (2 3))
-
-(deftest starts-with-subseq.start1
-    (starts-with-subseq "foo" "oop" :start1 1)
-  t
-  nil)
-
-(deftest starts-with-subseq.start2
-    (starts-with-subseq "foo" "xfoop" :start2 1)
-  t
-  nil)
-
-(deftest format-symbol.print-case-bound
-    (let ((upper (intern "FOO-BAR"))
-          (lower (intern "foo-bar"))
-          (*print-escape* nil))
-      (values
-       (let ((*print-case* :downcase))
-         (and (eq upper (format-symbol t "~A" upper))
-               (eq lower (format-symbol t "~A" lower))))
-       (let ((*print-case* :upcase))
-         (and (eq upper (format-symbol t "~A" upper))
-               (eq lower (format-symbol t "~A" lower))))
-       (let ((*print-case* :capitalize))
-         (and (eq upper (format-symbol t "~A" upper))
-              (eq lower (format-symbol t "~A" lower))))))
-  t
-  t
-  t)
-
-(deftest iota.fp-start-and-complex-integer-step
-    (equal '(#C(0.0 0.0) #C(0.0 2.0) #C(0.0 4.0))
-           (iota 3 :start 0.0 :step #C(0 2)))
-  t)
-
-(deftest parse-ordinary-lambda-list.1
-    (multiple-value-bind (req opt rest keys allowp aux keyp)
-        (parse-ordinary-lambda-list '(a b c
-                                      &optional o1 (o2 42) (o3 42 o3-supplied?)
-                                      &key (k1) ((:key k2)) (k3 42 k3-supplied?))
-                                    :normalize t)
-      (and (equal '(a b c) req)
-           (equal '((o1 nil nil)
-                    (o2 42 nil)
-                    (o3 42 o3-supplied?))
-                  opt)
-           (equal '(((:k1 k1) nil nil)
-                    ((:key k2) nil nil)
-                    ((:k3 k3) 42 k3-supplied?))
-                  keys)
-           (not allowp)
-           (not aux)
-           (eq t keyp)))
-  t)
diff --git a/third_party/lisp/alexandria/types.lisp b/third_party/lisp/alexandria/types.lisp
deleted file mode 100644
index 1942d0ecdf2a..000000000000
--- a/third_party/lisp/alexandria/types.lisp
+++ /dev/null
@@ -1,137 +0,0 @@
-(in-package :alexandria)
-
-(deftype array-index (&optional (length (1- array-dimension-limit)))
-  "Type designator for an index into array of LENGTH: an integer between
-0 (inclusive) and LENGTH (exclusive). LENGTH defaults to one less than
-ARRAY-DIMENSION-LIMIT."
-  `(integer 0 (,length)))
-
-(deftype array-length (&optional (length (1- array-dimension-limit)))
-  "Type designator for a dimension of an array of LENGTH: an integer between
-0 (inclusive) and LENGTH (inclusive). LENGTH defaults to one less than
-ARRAY-DIMENSION-LIMIT."
-  `(integer 0 ,length))
-
-;; This MACROLET will generate most of CDR5 (http://cdr.eurolisp.org/document/5/)
-;; except the RATIO related definitions and ARRAY-INDEX.
-(macrolet
-    ((frob (type &optional (base-type type))
-       (let ((subtype-names (list))
-             (predicate-names (list)))
-         (flet ((make-subtype-name (format-control)
-                  (let ((result (format-symbol :alexandria format-control
-                                               (symbol-name type))))
-                    (push result subtype-names)
-                    result))
-                (make-predicate-name (sybtype-name)
-                  (let ((result (format-symbol :alexandria '#:~A-p
-                                               (symbol-name sybtype-name))))
-                    (push result predicate-names)
-                    result))
-		(make-docstring (range-beg range-end range-type)
-		  (let ((inf (ecase range-type (:negative "-inf") (:positive "+inf"))))
-		    (format nil "Type specifier denoting the ~(~A~) range from ~A to ~A."
-			    type
-			    (if (equal range-beg ''*) inf (ensure-car range-beg))
-			    (if (equal range-end ''*) inf (ensure-car range-end))))))
-           (let* ((negative-name     (make-subtype-name '#:negative-~a))
-                  (non-positive-name (make-subtype-name '#:non-positive-~a))
-                  (non-negative-name (make-subtype-name '#:non-negative-~a))
-                  (positive-name     (make-subtype-name '#:positive-~a))
-                  (negative-p-name     (make-predicate-name negative-name))
-                  (non-positive-p-name (make-predicate-name non-positive-name))
-                  (non-negative-p-name (make-predicate-name non-negative-name))
-                  (positive-p-name     (make-predicate-name positive-name))
-                  (negative-extremum)
-                  (positive-extremum)
-                  (below-zero)
-                  (above-zero)
-                  (zero))
-             (setf (values negative-extremum below-zero
-                           above-zero positive-extremum zero)
-                   (ecase type
-                     (fixnum       (values 'most-negative-fixnum -1 1 'most-positive-fixnum 0))
-                     (integer      (values ''* -1       1        ''* 0))
-                     (rational     (values ''* '(0)     '(0)     ''* 0))
-                     (real         (values ''* '(0)     '(0)     ''* 0))
-                     (float        (values ''* '(0.0E0) '(0.0E0) ''* 0.0E0))
-                     (short-float  (values ''* '(0.0S0) '(0.0S0) ''* 0.0S0))
-                     (single-float (values ''* '(0.0F0) '(0.0F0) ''* 0.0F0))
-                     (double-float (values ''* '(0.0D0) '(0.0D0) ''* 0.0D0))
-                     (long-float   (values ''* '(0.0L0) '(0.0L0) ''* 0.0L0))))
-             `(progn
-                (deftype ,negative-name ()
-		  ,(make-docstring negative-extremum below-zero :negative)
-		  `(,',base-type ,,negative-extremum ,',below-zero))
-
-                (deftype ,non-positive-name ()
-		  ,(make-docstring negative-extremum zero :negative)
-		  `(,',base-type ,,negative-extremum ,',zero))
-
-                (deftype ,non-negative-name ()
-		  ,(make-docstring zero positive-extremum :positive)
-		  `(,',base-type ,',zero ,,positive-extremum))
-
-                (deftype ,positive-name ()
-		  ,(make-docstring above-zero positive-extremum :positive)
-		  `(,',base-type ,',above-zero ,,positive-extremum))
-
-                (declaim (inline ,@predicate-names))
-
-                (defun ,negative-p-name (n)
-                  (and (typep n ',type)
-                       (< n ,zero)))
-
-                (defun ,non-positive-p-name (n)
-                  (and (typep n ',type)
-                       (<= n ,zero)))
-
-                (defun ,non-negative-p-name (n)
-                  (and (typep n ',type)
-                       (<= ,zero n)))
-
-                (defun ,positive-p-name (n)
-                  (and (typep n ',type)
-                       (< ,zero n)))))))))
-  (frob fixnum integer)
-  (frob integer)
-  (frob rational)
-  (frob real)
-  (frob float)
-  (frob short-float)
-  (frob single-float)
-  (frob double-float)
-  (frob long-float))
-
-(defun of-type (type)
-  "Returns a function of one argument, which returns true when its argument is
-of TYPE."
-  (lambda (thing) (typep thing type)))
-
-(define-compiler-macro of-type (&whole form type &environment env)
-  ;; This can yeild a big benefit, but no point inlining the function
-  ;; all over the place if TYPE is not constant.
-  (if (constantp type env)
-      (with-gensyms (thing)
-        `(lambda (,thing)
-           (typep ,thing ,type)))
-      form))
-
-(declaim (inline type=))
-(defun type= (type1 type2)
-  "Returns a primary value of T is TYPE1 and TYPE2 are the same type,
-and a secondary value that is true is the type equality could be reliably
-determined: primary value of NIL and secondary value of T indicates that the
-types are not equivalent."
-  (multiple-value-bind (sub ok) (subtypep type1 type2)
-    (cond ((and ok sub)
-           (subtypep type2 type1))
-          (ok
-           (values nil ok))
-          (t
-           (multiple-value-bind (sub ok) (subtypep type2 type1)
-             (declare (ignore sub))
-             (values nil ok))))))
-
-(define-modify-macro coercef (type-spec) coerce
-  "Modify-macro for COERCE.")