1.1--- a/emacs/lib/sk.el Thu May 23 20:59:01 2024 -0400
1.2+++ b/emacs/lib/sk.el Fri May 24 14:40:38 2024 -0400
1.3@@ -67,7 +67,7 @@
1.4 :version skel-version)
1.5
1.6 ;; TODO 2023-09-06:
1.7-(define-derived-mode skel-mode lisp-data-mode "SKEL"
1.8+(define-derived-mode skel-mode lisp-mode "SKEL"
1.9 "skel-mode")
1.10
1.11 (defun maybe-skel-minor-mode ()
2.1--- a/lisp/ffi/rocksdb/db.lisp Thu May 23 20:59:01 2024 -0400
2.2+++ b/lisp/ffi/rocksdb/db.lisp Fri May 24 14:40:38 2024 -0400
2.3@@ -603,7 +603,8 @@
2.4 (define-alien-routine rocksdb-perfcontext-metric unsigned-long
2.5 (context (* rocksdb-perfcontext)) (metric int))
2.6
2.7-(define-alien-routine rocksdb-perfcontext-destroy void (* rocksdb-perfcontext))
2.8+;; TODO 2024-05-24: causes compile error - pass-by-struct not supported
2.9+;; (define-alien-routine rocksdb-perfcontext-destroy void (* rocksdb-perfcontext))
2.10
2.11 (export '(rocksdb-perfcontext-reset rocksdb-perfcontext-report
2.12 rocksdb-perfcontext-metric rocksdb-perfcontext-destroy rocksdb-set-perf-level))
3.1--- a/lisp/ffi/tree-sitter/ffi.lisp Thu May 23 20:59:01 2024 -0400
3.2+++ b/lisp/ffi/tree-sitter/ffi.lisp Fri May 24 14:40:38 2024 -0400
3.3@@ -47,10 +47,10 @@
3.4 (define-alien-routine ts-parser-new ts-parser)
3.5 (define-alien-routine ts-parser-delete void (self ts-parser))
3.6 (define-alien-routine ts-parser-reset void (self ts-parser))
3.7-(define-alien-routine ts-parser-logger ts-logger (self ts-parser))
3.8-(define-alien-routine ts-parser-set-logger void (self ts-parser) (logger ts-logger))
3.9+;; (define-alien-routine ts-parser-logger ts-logger (self ts-parser))
3.10+;; (define-alien-routine ts-parser-set-logger void (self ts-parser) (logger ts-logger))
3.11
3.12-(define-alien-routine ts-parser-set-language boolean (self ts-parser) (language ts-language))
3.13+;; (define-alien-routine ts-parser-set-language boolean (self ts-parser) (language ts-language))
3.14
3.15 (define-alien-routine ts-parser-language ts-language (self ts-parser))
3.16 (define-alien-routine ts-parser-parse ts-tree (self ts-parser) (old-tree ts-tree) (length unsigned-int))
3.17@@ -66,48 +66,48 @@
3.18 (define-alien-routine ts-tree-language ts-language (self ts-tree))
3.19 (define-alien-routine ts-tree-edit void (self ts-tree) (edit (* unsigned-int)))
3.20 (define-alien-routine ts-tree-print-dot-graph void (self ts-tree) (file-descriptor int))
3.21-(define-alien-routine ts-tree-root-node ts-node (self ts-tree))
3.22+;; (define-alien-routine ts-tree-root-node ts-node (self ts-tree))
3.23
3.24 ;;; Node
3.25-(define-alien-routine ts-node-type c-string (self ts-node))
3.26-(define-alien-routine ts-node-symbol ts-symbol (self ts-node))
3.27-(define-alien-routine ts-node-language ts-language (self ts-node))
3.28-(define-alien-routine ts-node-grammar-type c-string (self ts-node))
3.29-(define-alien-routine ts-node-grammar-symbol ts-symbol (self ts-node))
3.30-(define-alien-routine ts-node-start-byte unsigned-int (self ts-node))
3.31-(define-alien-routine ts-node-start-point ts-point (self ts-node))
3.32-(define-alien-routine ts-node-end-byte unsigned-int (self ts-node))
3.33-(define-alien-routine ts-node-end-point ts-point (self ts-node))
3.34-(define-alien-routine ts-node-string c-string (self ts-node))
3.35-(define-alien-routine ts-node-is-null boolean (self ts-node))
3.36-(define-alien-routine ts-node-is-named boolean (self ts-node))
3.37-(define-alien-routine ts-node-is-missing boolean (self ts-node))
3.38-(define-alien-routine ts-node-is-extra boolean (self ts-node))
3.39-(define-alien-routine ts-node-has-changes boolean (self ts-node))
3.40-(define-alien-routine ts-node-has-error boolean (self ts-node))
3.41-(define-alien-routine ts-node-parent ts-node (self ts-node))
3.42-(define-alien-routine ts-node-child ts-node (self ts-node) (cid unsigned-int))
3.43-(define-alien-routine ts-node-named-child ts-node (self ts-node) (cid unsigned-int))
3.44-(define-alien-routine ts-node-eq boolean (self ts-node) (other ts-node))
3.45+;; (define-alien-routine ts-node-type c-string (self ts-node))
3.46+;; (define-alien-routine ts-node-symbol ts-symbol (self ts-node))
3.47+;; (define-alien-routine ts-node-language ts-language (self ts-node))
3.48+;; (define-alien-routine ts-node-grammar-type c-string (self ts-node))
3.49+;; (define-alien-routine ts-node-grammar-symbol ts-symbol (self ts-node))
3.50+;; (define-alien-routine ts-node-start-byte unsigned-int (self ts-node))
3.51+;; (define-alien-routine ts-node-start-point ts-point (self ts-node))
3.52+;; (define-alien-routine ts-node-end-byte unsigned-int (self ts-node))
3.53+;; (define-alien-routine ts-node-end-point ts-point (self ts-node))
3.54+;; (define-alien-routine ts-node-string c-string (self ts-node))
3.55+;; (define-alien-routine ts-node-is-null boolean (self ts-node))
3.56+;; (define-alien-routine ts-node-is-named boolean (self ts-node))
3.57+;; (define-alien-routine ts-node-is-missing boolean (self ts-node))
3.58+;; (define-alien-routine ts-node-is-extra boolean (self ts-node))
3.59+;; (define-alien-routine ts-node-has-changes boolean (self ts-node))
3.60+;; (define-alien-routine ts-node-has-error boolean (self ts-node))
3.61+;; (define-alien-routine ts-node-parent ts-node (self ts-node))
3.62+;; (define-alien-routine ts-node-child ts-node (self ts-node) (cid unsigned-int))
3.63+;; (define-alien-routine ts-node-named-child ts-node (self ts-node) (cid unsigned-int))
3.64+;; (define-alien-routine ts-node-eq boolean (self ts-node) (other ts-node))
3.65 ;;; Tree Cursor
3.66-(define-alien-routine ts-tree-cursor-new ts-tree-cursor (node ts-node))
3.67+;; (define-alien-routine ts-tree-cursor-new ts-tree-cursor (node ts-node))
3.68
3.69-(define-alien-routine ts-tree-cursor-current-node ts-node (cursor (* ts-tree-cursor)))
3.70+;; (define-alien-routine ts-tree-cursor-current-node ts-node (cursor (* ts-tree-cursor)))
3.71
3.72-(define-alien-routine ts-tree-cursor-current-field-name c-string (cursor (* ts-tree-cursor)))
3.73+;; (define-alien-routine ts-tree-cursor-current-field-name c-string (cursor (* ts-tree-cursor)))
3.74
3.75-(define-alien-routine ts-tree-cursor-goto-next-sibling boolean (self (* ts-tree-cursor)))
3.76+;; (define-alien-routine ts-tree-cursor-goto-next-sibling boolean (self (* ts-tree-cursor)))
3.77
3.78-(define-alien-routine ts-tree-cursor-goto-parent boolean (self (* ts-tree-cursor)))
3.79+;; (define-alien-routine ts-tree-cursor-goto-parent boolean (self (* ts-tree-cursor)))
3.80
3.81-(define-alien-routine ts-tree-cursor-goto-first-child boolean (self (* ts-tree-cursor)))
3.82+;; (define-alien-routine ts-tree-cursor-goto-first-child boolean (self (* ts-tree-cursor)))
3.83
3.84-(define-alien-routine ts-tree-cursor-delete void (cursor (* ts-tree-cursor)))
3.85+;; (define-alien-routine ts-tree-cursor-delete void (cursor (* ts-tree-cursor)))
3.86
3.87-(define-alien-routine ts-language-version unsigned-int (v ts-language))
3.88-(define-alien-routine ts-language-symbol-count unsigned-int (v ts-language))
3.89-(define-alien-routine ts-language-symbol-name c-string (v ts-language) (s ts-symbol))
3.90-(define-alien-routine ts-language-field-count unsigned-int (v ts-language))
3.91+;; (define-alien-routine ts-language-version unsigned-int (v ts-language))
3.92+;; (define-alien-routine ts-language-symbol-count unsigned-int (v ts-language))
3.93+;; (define-alien-routine ts-language-symbol-name c-string (v ts-language) (s ts-symbol))
3.94+;; (define-alien-routine ts-language-field-count unsigned-int (v ts-language))
3.95
3.96 ;;; Query
3.97 (define-alien-routine ts-query-new (* ts-query)
4.1--- a/lisp/ffi/tree-sitter/pkg.lisp Thu May 23 20:59:01 2024 -0400
4.2+++ b/lisp/ffi/tree-sitter/pkg.lisp Fri May 24 14:40:38 2024 -0400
4.3@@ -17,7 +17,7 @@
4.4 ;;; Code:
4.5 (defpackage :tree-sitter
4.6 (:nicknames :ts)
4.7- (:use :cl :std :sb-alien)
4.8+ (:use :cl :std :sb-alien :std/alien)
4.9 (:export
4.10 :load-tree-sitter
4.11 :load-tree-sitter-wrapper
5.1--- a/lisp/lib/aud/mpd.lisp Thu May 23 20:59:01 2024 -0400
5.2+++ b/lisp/lib/aud/mpd.lisp Fri May 24 14:40:38 2024 -0400
5.3@@ -203,11 +203,12 @@
5.4 (condition (cdr (assoc error-id *error-ids-alist*))))
5.5 (error condition :text (subseq text (+ delimiter 2)))))
5.6
5.7-(defmacro with-mpc ((var &rest options) &body body)
5.8- `(let ((,var (connect ,@options)))
5.9- (unwind-protect
5.10- (progn ,@body)
5.11- (disconnect ,var))))
5.12+(eval-always
5.13+ (defmacro with-mpc ((var &rest options) &body body)
5.14+ `(let ((,var (connect ,@options)))
5.15+ (unwind-protect
5.16+ (progn ,@body)
5.17+ (disconnect ,var)))))
5.18
5.19 (defun send-command (connection command)
5.20 "Send command to MPD."
6.1--- a/lisp/lib/net/req.lisp Thu May 23 20:59:01 2024 -0400
6.2+++ b/lisp/lib/net/req.lisp Fri May 24 14:40:38 2024 -0400
6.3@@ -280,7 +280,7 @@
6.4 (main 0)))
6.5
6.6 ;;; keep-alive-stream
6.7-(defclass keep-alive-stream (sb-gray:fundamental-input-stream)
6.8+(defclass keep-alive-stream (fundamental-input-stream)
6.9 ((stream :type (or null stream)
6.10 :initarg :stream
6.11 :initform (error ":stream is required")
6.12@@ -309,7 +309,7 @@
6.13 (make-instance 'keep-alive-chunked-stream :stream stream :chunga-stream chunked-stream :on-close-or-eof on-close-or-eof)
6.14 (make-instance 'keep-alive-stream :stream stream :end end :on-close-or-eof on-close-or-eof)))
6.15
6.16-(defun maybe-close (stream &optional (close-if nil))
6.17+(defun maybe-close (stream &optional close-if)
6.18 "Will close the underlying stream if close-if is T (unless it is already closed).
6.19 If the stream is already closed or we closed it returns :EOF otherwise NIL."
6.20 (let ((underlying-stream (keep-alive-stream-stream stream)))
6.21@@ -347,27 +347,22 @@
6.22 byte))
6.23 (or (maybe-close stream t) :eof))))
6.24
6.25-(defmethod stream-read-sequence ((stream keep-alive-stream) sequence &optional (start 0) (end 0))
6.26- (declare (optimize speed)
6.27- (fixnum start end))
6.28- (let ((%stream (keep-alive-stream-stream stream)))
6.29- (if (null %stream) ;; we already closed it
6.30- start
6.31- (let* ((%end (keep-alive-stream-end stream))
6.32- (to-read (if %end
6.33- (min (- end start) (the fixnum %end))
6.34- (- end start)))
6.35- (n (read-sequence sequence %stream
6.36- :start start
6.37- :end (the fixnum (+ start to-read)))))
6.38- (when %end (decf (the fixnum (keep-alive-stream-end stream)) (- n start)))
6.39- (maybe-close stream (keep-alive-stream-end stream))
6.40- n))))
6.41-
6.42-(defmethod stream-read-sequence ((stream keep-alive-chunked-stream) sequence &optional start end)
6.43+(defmethod stream-read-sequence ((stream keep-alive-stream) sequence &optional (start 0) end)
6.44 (declare (optimize speed))
6.45 (if (null (keep-alive-stream-stream stream)) ;; we already closed it
6.46 start
6.47+ (let* ((to-read (min (print (- end start)) (keep-alive-stream-end stream)))
6.48+ (n (read-sequence sequence (keep-alive-stream-stream stream)
6.49+ :start start
6.50+ :end (+ start to-read))))
6.51+ (decf (keep-alive-stream-end stream) (print (- n start)))
6.52+ (maybe-close stream (<= (keep-alive-stream-end stream) 0))
6.53+ n)))
6.54+
6.55+(defmethod stream-read-sequence ((stream keep-alive-chunked-stream) sequence &optional (start 0) end)
6.56+ (declare (optimize speed))
6.57+ (if (null (print (keep-alive-stream-stream stream))) ;; we already closed it
6.58+ start
6.59 (if (chunga:chunked-stream-input-chunking-p (chunga-stream stream))
6.60 (prog1
6.61 (let ((num-read (read-sequence sequence (chunga-stream stream) :start start :end end)))
6.62@@ -502,22 +497,6 @@
6.63 last-char-size 0))
6.64 nil))
6.65
6.66-#+(or abcl clasp ecl)
6.67-(defmethod stream-read-sequence ((stream decoding-stream) sequence start end &key)
6.68- (loop for i from start to end
6.69- for char = (stream-read-char stream)
6.70- if (eq char :eof)
6.71- do (return i)
6.72- else do (setf (aref sequence i) char)
6.73- finally (return end)))
6.74-
6.75-#+(or clasp ecl)
6.76-(defmethod stream-read-byte ((stream decoding-stream))
6.77- (with-slots (last-char last-char-size) stream
6.78- (setf last-char #\Nul
6.79- last-char-size 0))
6.80- (read-byte (decoding-stream-stream stream) nil :eof))
6.81-
6.82 (defmethod open-stream-p ((stream decoding-stream))
6.83 (open-stream-p (decoding-stream-stream stream)))
6.84
6.85@@ -621,7 +600,7 @@
6.86 ((array (unsigned-byte 8) (*)) (write-sequence val stream))
6.87 (pathname
6.88 (with-open-file (in val :element-type '(unsigned-byte 8))
6.89- (std/stream:copy-stream in stream)))
6.90+ (alexandria:copy-stream in stream)))
6.91 (string
6.92 (write-sequence (convert-to-octets val) stream))
6.93 (cons (write-as-octets stream (first val)))
6.94@@ -922,7 +901,7 @@
6.95 (finishedp nil)
6.96 (content-length nil)
6.97 (transfer-encoding-p)
6.98- (parser (make-parser http
6.99+ (parser (make-http-parser http
6.100 :header-callback
6.101 (lambda (headers)
6.102 (setq header-finished-p t
6.103@@ -1668,10 +1647,10 @@
6.104 (apply #'request uri :method :delete args))
6.105
6.106 (defun fetch (uri destination &rest args
6.107- &key (if-exists :error)
6.108- version headers basic-auth bearer-auth cookie-jar keep-alive use-connection-pool
6.109- connect-timeout read-timeout max-redirects
6.110- ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path)
6.111+ &key (if-exists :error)
6.112+ version headers basic-auth bearer-auth cookie-jar keep-alive use-connection-pool
6.113+ connect-timeout read-timeout max-redirects
6.114+ ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path)
6.115 (declare (ignore version headers basic-auth bearer-auth cookie-jar keep-alive use-connection-pool
6.116 connect-timeout read-timeout max-redirects ssl-key-file ssl-cert-file
6.117 ssl-key-password stream verbose proxy insecure ca-path))
7.1--- a/lisp/lib/obj/hash/hasher.lisp Thu May 23 20:59:01 2024 -0400
7.2+++ b/lisp/lib/obj/hash/hasher.lisp Fri May 24 14:40:38 2024 -0400
7.3@@ -7,10 +7,8 @@
7.4 (eval-always
7.5 (defvar *global-hasher* #'sxhash))
7.6
7.7-(defconstant +global-hash+
7.8- (if (boundp '+global-hash+)
7.9- +global-hash+
7.10- (funcall *global-hasher* (get-universal-time))))
7.11+;; TODO 2024-05-24: do better
7.12+(define-constant +global-hash+ (funcall *global-hasher* (get-universal-time)) :test #'/=)
7.13
7.14 (macrolet ((specialize (str body) ; TODO 2023-12-21: test if this actually compiles to fastpath
7.15 `(if (typep ,str '(simple-array character 1))
8.1--- a/lisp/lib/obj/obj.asd Thu May 23 20:59:01 2024 -0400
8.2+++ b/lisp/lib/obj/obj.asd Fri May 24 14:40:38 2024 -0400
8.3@@ -21,6 +21,7 @@
8.4 (:file "id")
8.5 (:module "uri"
8.6 :components ((:file "pkg")
8.7+ (:file "domain")
8.8 (:file "uri")
8.9 (:file "mask")
8.10 (:file "state")
9.1--- a/lisp/lib/obj/uri/domain.lisp Thu May 23 20:59:01 2024 -0400
9.2+++ b/lisp/lib/obj/uri/domain.lisp Fri May 24 14:40:38 2024 -0400
9.3@@ -5,6 +5,33 @@
9.4 ;;; Code:
9.5 (in-package :obj/uri)
9.6
9.7+(eval-when (:compile-toplevel :load-toplevel :execute)
9.8+ (defparameter *default-etld-names*
9.9+ (probe-file #.(asdf:system-relative-pathname :prelude #P"../.stash/psl.dat")))
9.10+
9.11+ (defun load-etld-data (&optional (etld-names-file *default-etld-names*))
9.12+ (when etld-names-file
9.13+ (with-open-file (in etld-names-file
9.14+ :element-type #+lispworks :default #-lispworks 'character
9.15+ :external-format #+clisp charset:utf-8 #-clisp :utf-8)
9.16+ (loop with special-tlds = nil
9.17+ with normal-tlds = (make-hash-table :test 'equal)
9.18+ with wildcard-tlds = (make-hash-table :test 'equal)
9.19+ for line = (read-line in nil nil)
9.20+ while line
9.21+ unless (or (= 0 (length line))
9.22+ (starts-with-subseq "//" line))
9.23+ do (cond
9.24+ ((starts-with-subseq "*" line)
9.25+ (setf (gethash (subseq line 2) wildcard-tlds) t))
9.26+ ((starts-with-subseq "!" line)
9.27+ (push (subseq line 1) special-tlds))
9.28+ (t
9.29+ (setf (gethash line normal-tlds) t)))
9.30+ finally (return (list normal-tlds wildcard-tlds special-tlds)))))))
9.31+
9.32+(defvar *etlds* (load-etld-data))
9.33+
9.34 (defun next-subdomain (hostname &optional (start 0))
9.35 (let ((pos (position #\. hostname :start start)))
9.36 (when pos
9.37@@ -26,39 +53,38 @@
9.38 (setf current-pos pos)
9.39 subdomain))))))
9.40
9.41-(defvar *etlds* nil)
9.42-
9.43 (defun parse-domain (hostname)
9.44- (dolist (tld (third *etlds*))
9.45- (when (ends-with-subseq tld hostname)
9.46- (if (= (length tld) (length hostname))
9.47- (return-from parse-domain hostname)
9.48- (when (char= (aref hostname (- (length hostname) (length tld) 1))
9.49- #\.)
9.50- (return-from parse-domain
9.51- (subseq hostname
9.52- (- (length hostname) (length tld))))))))
9.53- (loop with iter = (make-subdomain-iter hostname)
9.54- with pre-prev-subdomain = nil
9.55- with prev-subdomain = nil
9.56- for subdomain = (funcall iter)
9.57- while subdomain
9.58- if (gethash subdomain (second *etlds*)) do
9.59- (return pre-prev-subdomain)
9.60- else if (gethash subdomain (first *etlds*)) do
9.61- (return (if (string= subdomain hostname)
9.62- nil
9.63- prev-subdomain))
9.64- do (setf pre-prev-subdomain prev-subdomain
9.65- prev-subdomain subdomain)
9.66- finally
9.67- (let* ((pos (position #\. hostname :from-end t))
9.68- (pos (and pos
9.69- (position #\. hostname :from-end t :end pos))))
9.70- (return
9.71- (if pos
9.72- (subseq hostname (1+ pos))
9.73- hostname)))))
9.74+ (when *etlds*
9.75+ (dolist (tld (third *etlds*))
9.76+ (when (ends-with-subseq tld hostname)
9.77+ (if (= (length tld) (length hostname))
9.78+ (return-from parse-domain hostname)
9.79+ (when (char= (aref hostname (- (length hostname) (length tld) 1))
9.80+ #\.)
9.81+ (return-from parse-domain
9.82+ (subseq hostname
9.83+ (- (length hostname) (length tld))))))))
9.84+ (loop with iter = (make-subdomain-iter hostname)
9.85+ with pre-prev-subdomain = nil
9.86+ with prev-subdomain = nil
9.87+ for subdomain = (funcall iter)
9.88+ while subdomain
9.89+ if (gethash subdomain (second *etlds*)) do
9.90+ (return pre-prev-subdomain)
9.91+ else if (gethash subdomain (first *etlds*)) do
9.92+ (return (if (string= subdomain hostname)
9.93+ nil
9.94+ prev-subdomain))
9.95+ do (setf pre-prev-subdomain prev-subdomain
9.96+ prev-subdomain subdomain)
9.97+ finally
9.98+ (let* ((pos (position #\. hostname :from-end t))
9.99+ (pos (and pos
9.100+ (position #\. hostname :from-end t :end pos))))
9.101+ (return
9.102+ (if pos
9.103+ (subseq hostname (1+ pos))
9.104+ hostname))))))
9.105
9.106 (defun uri-tld (uri)
9.107 (let ((host (uri-host uri)))
9.108@@ -207,9 +233,9 @@
9.109 (len (length ip-parsed)))
9.110 (loop for section in ip-parsed
9.111 if (string= section "")
9.112- append (make-list (- 9 len) :initial-element 0)
9.113+ append (make-list (- 9 len) :initial-element 0)
9.114 else
9.115- collect (parse-integer section :radix 16)))))
9.116+ collect (parse-integer section :radix 16)))))
9.117 (cond
9.118 ((ipv4-addr-p ip1)
9.119 (string= ip1 ip2))
10.1--- a/lisp/lib/pod/pod.asd Thu May 23 20:59:01 2024 -0400
10.2+++ b/lisp/lib/pod/pod.asd Fri May 24 14:40:38 2024 -0400
10.3@@ -15,8 +15,8 @@
10.4 (:file "api")
10.5 (:file "buildah")
10.6 (:file "podman")
10.7- (:file "util")
10.8- (:file "client"))
10.9+ (:file "client")
10.10+ (:file "util"))
10.11 :in-order-to ((test-op (test-op :pod/tests))))
10.12
10.13 (defsystem :pod/tests
11.1--- a/lisp/lib/rt/pkg.lisp Thu May 23 20:59:01 2024 -0400
11.2+++ b/lisp/lib/rt/pkg.lisp Fri May 24 14:40:38 2024 -0400
11.3@@ -439,10 +439,10 @@
11.4 (if *catch-test-errors*
11.5 (handler-bind
11.6 ((error
11.7- #'(lambda (c)
11.8- (setf %test-bail t)
11.9- (setf %test-result (make-test-result :fail c))
11.10- (return-from %test-bail %test-result))))
11.11+ (lambda (c)
11.12+ (setf %test-bail t)
11.13+ (setf %test-result (make-test-result :fail c))
11.14+ (return-from %test-bail %test-result))))
11.15 (%do))
11.16 (%do)))))
11.17
11.18@@ -637,7 +637,7 @@
11.19 (with-gensyms (form)
11.20 `(if ,(null args)
11.21 (if *testing*
11.22- (push-result (funcall 'rt::%test ,test ',test) *testing*)
11.23+ (push-result (funcall #'rt::%test ,test ',test) *testing*)
11.24 (funcall #'rt::%test ,test ',test))
11.25 (macrolet ((,form (test) `(let ,,(group args 2) ,test)))
11.26 ;; TODO 2023-09-21: does this work...
11.27@@ -654,13 +654,15 @@
11.28 (ensure-list condition-spec)
11.29 `(block ,block-name
11.30 (handler-bind ((,condition (lambda (c)
11.31+ (declare (ignore c))
11.32 ;; ok, body threw condition
11.33 ;; TODO 2023-09-05: result collectors
11.34 ;; (add-result 'test-passed
11.35 ;; :test-expr ',condition)
11.36 (return-from ,block-name (make-test-result :pass ',body)))))
11.37 (block nil
11.38- ,@body))
11.39+ (locally (declare (sb-ext:muffle-conditions warning))
11.40+ ,@body)))
11.41 (fail!
11.42 ',condition
11.43 ,@(if reason-control
12.1--- a/lisp/lib/skel/core/obj.lisp Thu May 23 20:59:01 2024 -0400
12.2+++ b/lisp/lib/skel/core/obj.lisp Fri May 24 14:40:38 2024 -0400
12.3@@ -146,7 +146,10 @@
12.4 ;; Note that SK-RUN directly on a rule currently does NOT touch the sources.
12.5 (defmethod sk-run ((self sk-rule))
12.6 (with-slots (recipe) self
12.7- (mapcar (lambda (x) (funcall x :output t))
12.8+ (mapcar (lambda (x)
12.9+ (etypecase x
12.10+ ((or symbol function) (funcall x :output t))
12.11+ (t (eval x))))
12.12 (sk-body recipe))))
12.13
12.14 (defmethod sk-write ((self sk-rule) stream)
13.1--- a/lisp/lib/skel/pkg.lisp Thu May 23 20:59:01 2024 -0400
13.2+++ b/lisp/lib/skel/pkg.lisp Fri May 24 14:40:38 2024 -0400
13.3@@ -31,7 +31,7 @@
13.4
13.5 ;;; Code:
13.6 (defpackage :skel/core
13.7- (:use :cl :cl-ppcre :std :sb-mop :obj/id :sb-bsd-sockets :sb-unix :sxp :log :cli :obj :vc)
13.8+ (:use :cl :cl-ppcre :std :sb-mop :obj/id :sb-bsd-sockets :sb-unix :sxp :log :cli :obj :vc :sb-ext)
13.9 (:import-from :cli :find-exe)
13.10 (:import-from :uiop :read-file-forms :ensure-absolute-pathname)
13.11 (:import-from :uiop/pathname :pathname-parent-directory-pathname)
14.1--- a/lisp/prelude.asd Thu May 23 20:59:01 2024 -0400
14.2+++ b/lisp/prelude.asd Fri May 24 14:40:38 2024 -0400
14.3@@ -2,13 +2,16 @@
14.4 (pushnew "PRELUDE" *modules* :test 'equal)
14.5
14.6 (defsystem :prelude
14.7- :depends-on (:std :cli :doc
14.8- :nlp :obj :organ :packy
14.9- :parse :pod :rdb :rt
14.10- :skel :syn :xdb :alsa
14.11+ :depends-on (:std :cli
14.12 :rocksdb :btrfs :uring
14.13+ :doc
14.14+ :nlp :obj
14.15+ :skel :syn
14.16+ :xdb :alsa
14.17+ :organ :packy
14.18 :tree-sitter :xkb :ssh2 :sndfile ;; magick
14.19 :zstd :uring :blake3 :ublk
14.20+ :parse :pod :rdb :rt
14.21 :nuklear :aud :cry :krypt
14.22 :io :gui :log :dat :net)
14.23 :build-operation monolithic-compile-bundle-op
15.1--- a/lisp/std/alien.lisp Thu May 23 20:59:01 2024 -0400
15.2+++ b/lisp/std/alien.lisp Fri May 24 14:40:38 2024 -0400
15.3@@ -31,11 +31,13 @@
15.4 ;; '(:with-pinned-objects :with-pinned-object-iterator :with-code-pages-pinned
15.5 ;; :sanctify-for-execution))
15.6
15.7-(defun shared-object-name (name path)
15.8+(defun shared-object-name (name &optional path)
15.9 "Return a filename with the correct extension for a shared library."
15.10- (merge-pathnames
15.11- #+darwin (format nil "lib~a.dylib" name)
15.12- #-darwin (format nil "lib~a.so" name) path))
15.13+ (let ((name #+darwin (format nil "lib~a.dylib" name)
15.14+ #-darwin (format nil "lib~a.so" name)))
15.15+ (if path
15.16+ (merge-pathnames name path)
15.17+ (pathname name))))
15.18
15.19 (defun list-all-shared-objects ()
15.20 sb-alien::*shared-objects*)
16.1--- a/lisp/std/list.lisp Thu May 23 20:59:01 2024 -0400
16.2+++ b/lisp/std/list.lisp Fri May 24 14:40:38 2024 -0400
16.3@@ -99,6 +99,7 @@
16.4 (circularp elt (cons object seen))))))))))
16.5 (circularp object nil)))
16.6
16.7+;;; On Lisp
16.8 (defun group (source n)
16.9 (declare (fixnum n))
16.10 (when (zerop n) (error "zero length"))
17.1--- a/lisp/std/tests.lisp Thu May 23 20:59:01 2024 -0400
17.2+++ b/lisp/std/tests.lisp Fri May 24 14:40:38 2024 -0400
17.3@@ -26,9 +26,8 @@
17.4 (is (equal (funcall {1 list 1} 2) '(1 2))) ;; curry.fixed-arity
17.5 (is (equal (funcall {2 list _ 2} 3 4) '(3 4 2))) ;; curry.fixed-arity.2
17.6 (signals error
17.7- (locally (declare (optimize safety))
17.8- (let ((f {1 list 1}))
17.9- (progn (funcall f) nil)))) ;; curry.fixed-arity.1
17.10+ (let ((f {1 list 1}))
17.11+ (progn (funcall f) nil))) ;; curry.fixed-arity.1
17.12 (signals error
17.13 (locally (declare (optimize safety))
17.14 (let ((f {1 list 1}))
17.15@@ -145,7 +144,8 @@
17.16
17.17 (deftest tasks ()
17.18 "Test task-pools, oracles, and workers."
17.19- (let ((pool1 (make-task-pool)))))
17.20+ ;; (let ((pool1 (make-task-pool))))
17.21+ )
17.22
17.23 (deftest fmt ()
17.24 "Test standard formatters"
18.1--- a/skelfile Thu May 23 20:59:01 2024 -0400
18.2+++ b/skelfile Fri May 24 14:40:38 2024 -0400
18.3@@ -14,7 +14,8 @@
18.4 :env (home (cc "clang") shell term)
18.5 :rules
18.6 ((all (x compile std prelude build))
18.7- (x () #$if [ ! -f x ];
18.8+ (x ()
18.9+ #$if [ ! -f x ];
18.10 then ./x.lisp
18.11 fi$#)
18.12 (clean ()
18.13@@ -23,6 +24,10 @@
18.14 #$find emacs -name '*.elc' -type f -delete$#
18.15 #$find lisp -name '*.fasl' -type f -delete$#
18.16 #$echo 'cargo clean:' && cd rust && cargo clean$#)
18.17+ (psl.dat ()
18.18+ (with-open-file (st ".stash/psl.dat" :direction :output :element-type 'octet)
18.19+ (loop for x across (req:get "https://publicsuffix.org/list/public_suffix_list.dat" :force-binary t)
18.20+ do (write-byte x st))))
18.21 (rdb (x) #$./x build rdb$#)
18.22 (skel (x) #$./x build skel$#)
18.23 (organ (x) #$./x build organ$#)
19.1--- a/x.lisp Thu May 23 20:59:01 2024 -0400
19.2+++ b/x.lisp Fri May 24 14:40:38 2024 -0400
19.3@@ -188,6 +188,7 @@
19.4 (defun x-test (args)
19.5 (if args
19.6 (let ((name (car args)))
19.7+ (ql:quickload :rt)
19.8 (ql:quickload (string-upcase (format nil "~A/tests" name)))
19.9 (rt:do-tests (string-upcase name) t))
19.10 (bail "missing arg")))
