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>

1 files changed, 0 insertions, 370 deletions

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)))
-
-
-