1.1--- a/emacs/default.el Tue Oct 01 22:29:08 2024 -0400
1.2+++ b/emacs/default.el Tue Oct 01 23:34:01 2024 -0400
1.3@@ -369,21 +369,25 @@
1.4 ;; :ensure t
1.5 ;; :config
1.6 ;; (setq graphviz-dot-indent-width 2))
1.7+
1.8 ;;; Comments
1.9 (defcustom prog-comment-keywords
1.10 '("TODO" "REVIEW" "FIX" "HACK" "RESEARCH")
1.11 "List of strings with comment keywords."
1.12- :group 'default)
1.13+ :group 'default
1.14+ :type 'list)
1.15
1.16 (defcustom prog-comment-timestamp-format-concise "%F"
1.17 "Specifier for date in `prog-comment-timestamp-keyword'.
1.18 Refer to the doc string of `format-time-string' for the available
1.19 options."
1.20- :group 'default)
1.21+ :group 'default
1.22+ :type 'string)
1.23
1.24 (defcustom prog-comment-timestamp-format-verbose "%F %T %z"
1.25 "Like `prog-comment-timestamp-format-concise', but longer."
1.26- :group 'default)
1.27+ :group 'default
1.28+ :type 'string)
1.29
1.30 ;;;###autoload
1.31 (defun prog-comment-dwim (arg)
1.32@@ -570,7 +574,8 @@
1.33 ;;; Scratch
1.34 (defcustom default-scratch-buffer-mode 'lisp-interaction-mode
1.35 "Default major mode for new scratch buffers"
1.36- :group 'default)
1.37+ :group 'default
1.38+ :type 'symbol)
1.39
1.40 ;; Adapted from the `scratch.el' package by Ian Eure.
1.41 (defun default-scratch-list-modes ()
2.1--- a/lisp/lib/aud/pkg.lisp Tue Oct 01 22:29:08 2024 -0400
2.2+++ b/lisp/lib/aud/pkg.lisp Tue Oct 01 23:34:01 2024 -0400
2.3@@ -1,5 +1,8 @@
2.4 (defpackage :aud
2.5- (:use :cl :std :dat/midi :obj/music :sndfile :alsa))
2.6+ (:use :cl :std :dat/midi :sndfile :alsa))
2.7+
2.8+(defpackage :aud/music
2.9+ (:use :cl :std :aud))
2.10
2.11 (defpackage :aud/mpd
2.12 (:use :cl :std :sb-bsd-sockets :net/core :net/util)
3.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
3.2+++ b/lisp/lib/io/fast.lisp Tue Oct 01 23:34:01 2024 -0400
3.3@@ -0,0 +1,468 @@
3.4+;;; fast.lisp --- Fast Octet Streams
3.5+
3.6+;; based on https://github.com/rpav/fast-io/tree/master
3.7+
3.8+;;; Code:
3.9+(in-package :io/fast)
3.10+
3.11+ ;; Vector buffer
3.12+
3.13+(defvar *default-output-buffer-size* 16)
3.14+
3.15+(declaim (ftype (function (array-index) octet-vector) make-octet-vector)
3.16+ (inline make-octet-vector))
3.17+(defun make-octet-vector (len)
3.18+ (make-array (the array-index len) :element-type 'octet))
3.19+
3.20+(declaim (inline output-buffer-vector output-buffer-fill output-buffer-len))
3.21+(defstruct output-buffer
3.22+ (vector (make-octet-vector *default-output-buffer-size*)
3.23+ :type octet-vector)
3.24+ (fill 0 :type array-index)
3.25+ (len 0 :type array-index)
3.26+ (queue nil :type list)
3.27+ (last nil :type list)
3.28+ (output nil))
3.29+
3.30+(defstruct input-buffer
3.31+ (vector nil :type (or null octet-vector))
3.32+ (pos 0 :type array-index)
3.33+ (stream nil))
3.34+
3.35+(defun buffer-position (buffer)
3.36+ "Return the number of bytes read (for an INPUT-BUFFER) or written
3.37+ (for an OUTPUT-BUFFER)"
3.38+ (etypecase buffer
3.39+ (input-buffer (input-buffer-pos buffer))
3.40+ (output-buffer (output-buffer-len buffer))))
3.41+
3.42+;; Sometimes it is usefull just to skip the buffer instead of reading from it.
3.43+(defun (setf buffer-position) (new-pos buffer)
3.44+ "Set the buffer position for input-buffer"
3.45+ (check-type buffer input-buffer)
3.46+ (let* ((pos (input-buffer-pos buffer))
3.47+ (vec (input-buffer-vector buffer))
3.48+ (vec-len (length vec)))
3.49+ (declare (optimize (speed 3) (safety 1))
3.50+ (type octet-vector vec)
3.51+ (type non-negative-fixnum pos vec-len new-pos))
3.52+ ;; Only need to update if pos or new-pos is in stream range.
3.53+ (when-let ((stream-update-needed? (or (> pos vec-len)
3.54+ (> new-pos vec-len)))
3.55+ (stream (input-buffer-stream buffer)))
3.56+ (let* ((stream-file-pos (file-position stream))
3.57+ (pos-diff (- new-pos pos))
3.58+ (stream-diff (cond ((and (> pos vec-len)
3.59+ (< new-pos vec-len))
3.60+ ;; branch for pos in stream and new-pos
3.61+ ;; is in vector.
3.62+ (- vec-len pos))
3.63+ ((and (< pos vec-len)
3.64+ (> new-pos vec-len))
3.65+ ;; branch for pos in vector. and new-pos
3.66+ ;; is in stream.
3.67+ (- pos-diff (- vec-len pos)))
3.68+ ;; otherwise stream-diff = pos-diff.
3.69+ (t pos-diff)))
3.70+ (new-stream-pos (+ stream-file-pos stream-diff)))
3.71+ (declare (type non-negative-fixnum stream-file-pos new-stream-pos)
3.72+ (type fixnum pos-diff stream-diff))
3.73+ (file-position stream new-stream-pos))))
3.74+ (setf (slot-value buffer 'pos) new-pos))
3.75+
3.76+(defun octets-from (sequence)
3.77+ (let ((vec (make-octet-vector (length sequence))))
3.78+ (replace vec sequence)
3.79+ vec))
3.80+
3.81+(defun concat-buffer (buffer)
3.82+ (let* ((len (output-buffer-len buffer))
3.83+ (array
3.84+ #+fast-io-sv
3.85+ (if (eq :static (output-buffer-output buffer))
3.86+ (static-vectors:make-static-vector (the array-index len))
3.87+ (make-octet-vector len))
3.88+ #-fast-io-sv
3.89+ (make-octet-vector len)))
3.90+ (loop as i = 0 then (+ i (length a))
3.91+ for a in (output-buffer-queue buffer) do
3.92+ (replace (the octet-vector array)
3.93+ (the octet-vector a) :start1 i)
3.94+ finally
3.95+ (replace (the octet-vector array)
3.96+ (output-buffer-vector buffer)
3.97+ :start1 i
3.98+ :end2 (output-buffer-fill buffer)))
3.99+ array))
3.100+
3.101+(defun flush (output-buffer)
3.102+ (when (> (output-buffer-fill output-buffer) 0)
3.103+ (write-sequence (output-buffer-vector output-buffer)
3.104+ (output-buffer-output output-buffer)
3.105+ :start 0 :end (output-buffer-fill output-buffer))
3.106+ (prog1 (output-buffer-fill output-buffer)
3.107+ (setf (output-buffer-fill output-buffer) 0))))
3.108+
3.109+(defun extend (buffer &optional (min 1))
3.110+ (let ((vector (output-buffer-vector buffer)))
3.111+ (setf (output-buffer-last buffer)
3.112+ (nconc (output-buffer-last buffer)
3.113+ (cons vector nil))
3.114+ (output-buffer-vector buffer)
3.115+ (make-octet-vector (max min (1+ (* 2 (length vector)))))
3.116+ (output-buffer-fill buffer) 0)
3.117+ (unless (output-buffer-queue buffer)
3.118+ (setf (output-buffer-queue buffer)
3.119+ (output-buffer-last buffer)))))
3.120+
3.121+(defun fast-write-byte (byte output-buffer)
3.122+ (declare (type octet byte)
3.123+ (type output-buffer output-buffer)
3.124+ (optimize (speed 3) (safety 1)))
3.125+ (when (= (output-buffer-fill output-buffer)
3.126+ (array-dimension (output-buffer-vector output-buffer) 0))
3.127+ (if (streamp (output-buffer-output output-buffer))
3.128+ (flush output-buffer)
3.129+ (extend output-buffer)))
3.130+ (prog1
3.131+ (setf (aref (output-buffer-vector output-buffer)
3.132+ (output-buffer-fill output-buffer))
3.133+ byte)
3.134+ (incf (output-buffer-fill output-buffer))
3.135+ (incf (output-buffer-len output-buffer))))
3.136+
3.137+(defun fast-read-byte (input-buffer &optional (eof-error-p t) eof-value)
3.138+ (declare (type input-buffer input-buffer))
3.139+ (when-let ((vec (input-buffer-vector input-buffer))
3.140+ (pos (input-buffer-pos input-buffer)))
3.141+ (when (< pos (length vec))
3.142+ (incf (input-buffer-pos input-buffer))
3.143+ (return-from fast-read-byte (aref vec pos))))
3.144+ (when-let ((stream (input-buffer-stream input-buffer)))
3.145+ (let ((byte (read-byte stream eof-error-p eof-value)))
3.146+ (unless (equal byte eof-value)
3.147+ (incf (input-buffer-pos input-buffer)))
3.148+ (return-from fast-read-byte byte)))
3.149+ (if eof-error-p
3.150+ (error 'end-of-file :stream input-buffer)
3.151+ eof-value))
3.152+
3.153+(defun fast-peek-byte (input-buffer &optional peek-type (eof-error-p t) eof-value)
3.154+ "This is like `peek-byte' only for fast-io input-buffers."
3.155+ (declare (type input-buffer input-buffer))
3.156+ (loop :for octet = (fast-read-byte input-buffer eof-error-p :eof)
3.157+ :for new-pos :from (input-buffer-pos input-buffer)
3.158+ :until (cond ((eq octet :eof)
3.159+ (return eof-value))
3.160+ ((null peek-type))
3.161+ ((eq peek-type 't)
3.162+ (plusp octet))
3.163+ ((= octet peek-type)))
3.164+ :finally (setf (buffer-position input-buffer) new-pos)
3.165+ (return octet)))
3.166+
3.167+(defun fast-write-sequence (sequence output-buffer &optional (start 0) end)
3.168+ (if (streamp (output-buffer-output output-buffer))
3.169+ (progn
3.170+ (flush output-buffer)
3.171+ (write-sequence sequence (output-buffer-output output-buffer) :start start :end end))
3.172+ (progn
3.173+ (let* ((start2 start)
3.174+ (len (if end
3.175+ (- end start)
3.176+ (- (length sequence) start)))
3.177+ (buffer-remaining
3.178+ (- (length (output-buffer-vector output-buffer))
3.179+ (output-buffer-fill output-buffer))))
3.180+ (when (> buffer-remaining 0)
3.181+ (replace (output-buffer-vector output-buffer)
3.182+ (the octet-vector sequence)
3.183+ :start1 (output-buffer-fill output-buffer)
3.184+ :start2 start2
3.185+ :end2 end)
3.186+ (incf start2 buffer-remaining)
3.187+ (incf (output-buffer-fill output-buffer)
3.188+ (min buffer-remaining len)))
3.189+ (let ((sequence-remaining (- (or end (length sequence)) start2)))
3.190+ (when (> sequence-remaining 0)
3.191+ (extend output-buffer sequence-remaining)
3.192+ (replace (output-buffer-vector output-buffer)
3.193+ (the octet-vector sequence)
3.194+ :start2 start2
3.195+ :end2 end)
3.196+ (incf (output-buffer-fill output-buffer) sequence-remaining)))
3.197+ (incf (output-buffer-len output-buffer) len)
3.198+ len))))
3.199+
3.200+(defun fast-read-sequence (sequence input-buffer &optional (start 0) end)
3.201+ (declare (type octet-vector sequence)
3.202+ (type input-buffer input-buffer))
3.203+ (let ((start1 start)
3.204+ (total-len (if end
3.205+ (- end start)
3.206+ (- (length sequence) start))))
3.207+ (when-let ((vec (input-buffer-vector input-buffer))
3.208+ (pos (input-buffer-pos input-buffer)))
3.209+ (when (< pos (length vec))
3.210+ (let ((len (min total-len (- (length vec) pos))))
3.211+ (replace sequence vec
3.212+ :start1 start1
3.213+ :start2 pos
3.214+ :end2 (+ pos len))
3.215+ (incf (input-buffer-pos input-buffer) len)
3.216+ (incf start1 len))))
3.217+ (when (< start1 total-len)
3.218+ (when-let ((stream (input-buffer-stream input-buffer)))
3.219+ (let ((bytes-read (read-sequence sequence stream
3.220+ :start start1
3.221+ :end (+ total-len start1))))
3.222+ (incf (input-buffer-pos input-buffer) bytes-read)
3.223+ (return-from fast-read-sequence bytes-read))))
3.224+ start1))
3.225+
3.226+(defun finish-output-buffer (output-buffer)
3.227+ "Finish an output buffer. If it is backed by a vector (static or otherwise)
3.228+it returns the final octet vector. If it is backed by a stream it ensures that
3.229+all data has been flushed to the stream."
3.230+ (if (streamp (output-buffer-output output-buffer))
3.231+ (flush output-buffer)
3.232+ (concat-buffer output-buffer)))
3.233+
3.234+(defmacro with-fast-output ((buffer &optional output) &body body)
3.235+ "Create `BUFFER`, optionally outputting to `OUTPUT`."
3.236+ `(let ((,buffer (make-output-buffer :output ,output)))
3.237+ ,@body
3.238+ (if (streamp (output-buffer-output ,buffer))
3.239+ (flush ,buffer)
3.240+ (finish-output-buffer ,buffer))))
3.241+
3.242+(defmacro with-fast-input ((buffer vector &optional stream (offset 0)) &body body)
3.243+ `(let ((,buffer (make-input-buffer :vector ,vector :stream ,stream :pos ,offset)))
3.244+ ,@body))
3.245+
3.246+ ;; READx and WRITEx
3.247+;;; WRITE-UNSIGNED-BE, READ-UNSIGNED-BE, etc taken from PACK, which is
3.248+;;; in the public domain.
3.249+
3.250+(defmacro write-unsigned-be (value size buffer)
3.251+ (once-only (value buffer)
3.252+ `(progn
3.253+ ,@(loop for i from (* (1- size) 8) downto 0 by 8
3.254+ collect `(fast-write-byte (ldb (byte 8 ,i) ,value) ,buffer)))))
3.255+
3.256+(defmacro read-unsigned-be (size buffer)
3.257+ (with-gensyms (value)
3.258+ (once-only (buffer)
3.259+ `(let ((,value 0))
3.260+ ,@(loop for i from (* (1- size) 8) downto 0 by 8
3.261+ collect `(setf (ldb (byte 8 ,i) ,value) (fast-read-byte ,buffer)))
3.262+ ,value))))
3.263+
3.264+(defmacro write-unsigned-le (value size buffer)
3.265+ (once-only (value buffer)
3.266+ `(progn
3.267+ ,@(loop for i from 0 below (* 8 size) by 8
3.268+ collect `(fast-write-byte (ldb (byte 8 ,i) ,value) ,buffer)))))
3.269+
3.270+(defmacro read-unsigned-le (size buffer)
3.271+ (with-gensyms (value)
3.272+ (once-only (buffer)
3.273+ `(let ((,value 0))
3.274+ ,@(loop for i from 0 below (* 8 size) by 8
3.275+ collect `(setf (ldb (byte 8 ,i) ,value) (fast-read-byte ,buffer)))
3.276+ ,value))))
3.277+
3.278+(declaim (inline unsigned-to-signed))
3.279+(defun unsigned-to-signed (value size)
3.280+ (let ((max-signed (expt 2 (1- (* 8 size))))
3.281+ (to-subtract (expt 2 (* 8 size))))
3.282+ (if (>= value max-signed)
3.283+ (- value to-subtract)
3.284+ value)))
3.285+
3.286+(declaim (inline signed-to-unsigned))
3.287+(defun signed-to-unsigned (value size)
3.288+ (if (minusp value)
3.289+ (+ value (expt 2 (* 8 size)))
3.290+ value))
3.291+
3.292+(defmacro make-readers (&rest bitlens)
3.293+ (let ((names (mapcar (lambda (n)
3.294+ (mapcar (lambda (m) (symbolicate (format nil m n)))
3.295+ '("READ~A-BE" "READU~A-BE"
3.296+ "READ~A-LE" "READU~A-LE")))
3.297+ bitlens)))
3.298+ `(eval-when (:compile-toplevel :load-toplevel :execute)
3.299+ (declaim (inline ,@(flatten names)))
3.300+ ,@(loop for fun in names
3.301+ for bits in bitlens
3.302+ as bytes = (truncate bits 8)
3.303+ collect
3.304+ `(progn
3.305+ (defun ,(first fun) (buffer)
3.306+ (unsigned-to-signed (read-unsigned-be ,bytes buffer) ,bytes))
3.307+ (defun ,(second fun) (buffer)
3.308+ (read-unsigned-be ,bytes buffer))
3.309+ (defun ,(third fun) (buffer)
3.310+ (unsigned-to-signed (read-unsigned-le ,bytes buffer) ,bytes))
3.311+ (defun ,(fourth fun) (buffer)
3.312+ (read-unsigned-le ,bytes buffer)))))))
3.313+
3.314+(defmacro make-writers (&rest bitlens)
3.315+ (let ((names (mapcar (lambda (n)
3.316+ (mapcar (lambda (m) (symbolicate (format nil m n)))
3.317+ '("WRITE~A-BE" "WRITEU~A-BE"
3.318+ "WRITE~A-LE" "WRITEU~A-LE")))
3.319+ bitlens)))
3.320+ `(eval-when (:compile-toplevel :load-toplevel :execute)
3.321+ (declaim (notinline ,@(flatten names)))
3.322+ ,@(loop for fun in names
3.323+ for bits in bitlens
3.324+ as bytes = (truncate bits 8)
3.325+ collect
3.326+ `(progn
3.327+ (defun ,(first fun) (value buffer)
3.328+ (declare (type (signed-byte ,bits) value))
3.329+ (write-unsigned-be (the (unsigned-byte ,bits)
3.330+ (signed-to-unsigned value ,bytes)) ,bytes buffer))
3.331+ (defun ,(second fun) (value buffer)
3.332+ (declare (type (unsigned-byte ,bits) value))
3.333+ (write-unsigned-be (the (unsigned-byte ,bits) value)
3.334+ ,bytes buffer))
3.335+ (defun ,(third fun) (value buffer)
3.336+ (declare (type (signed-byte ,bits) value))
3.337+ (write-unsigned-le (the (unsigned-byte ,bits)
3.338+ (signed-to-unsigned value ,bytes)) ,bytes buffer))
3.339+ (defun ,(fourth fun) (value buffer)
3.340+ (declare (type (unsigned-byte ,bits) value))
3.341+ (write-unsigned-le (the (unsigned-byte ,bits) value)
3.342+ ,bytes buffer)))))))
3.343+
3.344+(make-writers 16 24 32 64 128)
3.345+(make-readers 16 24 32 64 128)
3.346+
3.347+(declaim (inline write8 writeu8 read8 readu8))
3.348+(defun write8 (value buffer)
3.349+ (declare (type (signed-byte 8) value))
3.350+ (fast-write-byte (signed-to-unsigned value 1) buffer))
3.351+
3.352+(defun writeu8 (value buffer)
3.353+ (declare (type (unsigned-byte 8) value))
3.354+ (fast-write-byte value buffer))
3.355+
3.356+
3.357+(defun read8 (buffer)
3.358+ (unsigned-to-signed (fast-read-byte buffer) 1))
3.359+
3.360+(defun readu8 (buffer)
3.361+ (fast-read-byte buffer))
3.362+
3.363+(setf (symbol-function 'write8-le) #'write8)
3.364+(setf (symbol-function 'write8-be) #'write8)
3.365+(setf (symbol-function 'writeu8-le) #'writeu8)
3.366+(setf (symbol-function 'writeu8-be) #'writeu8)
3.367+
3.368+(setf (symbol-function 'read8-le) #'read8)
3.369+(setf (symbol-function 'read8-be) #'read8)
3.370+(setf (symbol-function 'readu8-le) #'readu8)
3.371+(setf (symbol-function 'readu8-be) #'readu8)
3.372+
3.373+;; fast-stream
3.374+
3.375+(defclass fast-io-stream (fundamental-stream)
3.376+ ((openp :type boolean :initform t)))
3.377+
3.378+(defmethod stream-file-position ((stream fast-io-stream))
3.379+ (with-slots (buffer) stream
3.380+ (buffer-position buffer)))
3.381+
3.382+(defmethod open-stream-p ((stream fast-io-stream))
3.383+ (slot-value stream 'openep))
3.384+
3.385+ ;; fast-output-stream
3.386+
3.387+(defclass fast-output-stream (fast-io-stream fundamental-output-stream)
3.388+ ((buffer :type output-buffer)))
3.389+
3.390+(defmethod initialize-instance ((self fast-output-stream) &key stream
3.391+ buffer-size &allow-other-keys)
3.392+ (call-next-method)
3.393+ (let ((*default-output-buffer-size* (or buffer-size *default-output-buffer-size*)))
3.394+ (with-slots (buffer) self
3.395+ (setf buffer (make-output-buffer :output stream)))))
3.396+
3.397+(defmethod output-stream-p ((stream fast-output-stream))
3.398+ (with-slots (buffer) stream
3.399+ (and (typep buffer 'output-buffer))))
3.400+
3.401+(defmethod stream-element-type ((stream fast-output-stream))
3.402+ "Return the underlying array element-type.
3.403+ Should always return '(unsigned-byte 8)."
3.404+ (with-slots (buffer) stream
3.405+ (array-element-type (output-buffer-vector buffer))))
3.406+
3.407+(defmethod stream-write-byte ((stream fast-output-stream) byte)
3.408+ (with-slots (buffer) stream
3.409+ (fast-write-byte byte buffer)))
3.410+
3.411+(defmethod stream-write-sequence ((stream fast-output-stream) sequence start end
3.412+ &key &allow-other-keys)
3.413+ (with-slots (buffer) stream
3.414+ (fast-write-sequence sequence buffer start end))
3.415+ sequence)
3.416+
3.417+(defun finish-output-stream (stream)
3.418+ (with-slots (buffer) stream
3.419+ (if (streamp (output-buffer-output buffer))
3.420+ (flush buffer)
3.421+ (finish-output-buffer buffer))))
3.422+
3.423+(defmethod close ((stream fast-output-stream) &key abort)
3.424+ (declare (ignore abort))
3.425+ (finish-output-stream stream)
3.426+ (setf (slot-value stream 'openp) nil))
3.427+
3.428+ ;; fast-input-stream
3.429+
3.430+(defclass fast-input-stream (fast-io-stream fundamental-input-stream)
3.431+ ((buffer :type input-buffer)))
3.432+
3.433+(defmethod initialize-instance ((self fast-input-stream) &key stream
3.434+ vector &allow-other-keys)
3.435+ (call-next-method)
3.436+ (with-slots (buffer) self
3.437+ (setf buffer (make-input-buffer :vector vector :stream stream))))
3.438+
3.439+(defmethod input-stream-p ((stream fast-input-stream))
3.440+ (with-slots (buffer) stream
3.441+ (and (typep buffer 'input-buffer))))
3.442+
3.443+(defmethod stream-element-type ((stream fast-input-stream))
3.444+ "Return element-type of the underlying vector or stream.
3.445+ Return NIL if none are present."
3.446+ (with-slots (buffer) stream
3.447+ (if-let ((vec (input-buffer-vector buffer)))
3.448+ (array-element-type vec)
3.449+ (when-let ((stream (input-buffer-stream buffer)))
3.450+ (stream-element-type stream)))))
3.451+
3.452+(defmethod (setf stream-file-position) (new-pos (stream fast-input-stream))
3.453+ (with-slots (buffer) stream
3.454+ (setf (buffer-position buffer) new-pos)))
3.455+
3.456+(defmethod peek-byte ((stream fast-input-stream) &optional peek-type (eof-error-p t) eof-value)
3.457+ (with-slots (buffer) stream
3.458+ (fast-peek-byte buffer peek-type eof-error-p eof-value)))
3.459+
3.460+(defmethod stream-read-byte ((stream fast-input-stream))
3.461+ (with-slots (buffer) stream
3.462+ (fast-read-byte buffer)))
3.463+
3.464+(defmethod stream-read-sequence ((stream fast-input-stream) sequence start end
3.465+ &key &allow-other-keys)
3.466+ (with-slots (buffer) stream
3.467+ (fast-read-sequence sequence buffer start end)))
3.468+
3.469+(defmethod close ((stream fast-input-stream) &key abort)
3.470+ (declare (ignore abort))
3.471+ (setf (slot-value stream 'openp) nil))
4.1--- a/lisp/lib/io/io.asd Tue Oct 01 22:29:08 2024 -0400
4.2+++ b/lisp/lib/io/io.asd Tue Oct 01 23:34:01 2024 -0400
4.3@@ -9,6 +9,7 @@
4.4 :version "0.1.0"
4.5 :serial t
4.6 :components ((:file "pkg")
4.7+ (:file "fast")
4.8 (:file "ring" :if-feature :linux)
4.9 (:file "socket")
4.10 (:file "stream")
5.1--- a/lisp/lib/io/pkg.lisp Tue Oct 01 22:29:08 2024 -0400
5.2+++ b/lisp/lib/io/pkg.lisp Tue Oct 01 23:34:01 2024 -0400
5.3@@ -16,6 +16,27 @@
5.4 (:use :cl :std/condition)
5.5 (:export :io-error))
5.6
5.7+(defpackage :io/fast
5.8+ (:use :cl :std :io/proto)
5.9+ (:export
5.10+ #:fast-read-byte #:fast-write-byte
5.11+ #:fast-read-sequence #:fast-write-sequence
5.12+ #:with-fast-input #:with-fast-output
5.13+ #:write8 #:writeu8
5.14+ #:write8-le #:writeu8-le #:write8-be #:writeu8-be
5.15+ #:write16-le #:writeu16-le #:write16-be #:writeu16-be
5.16+ #:write24-le #:writeu24-le #:write24-be #:writeu24-be
5.17+ #:write32-le #:writeu32-le #:write32-be #:writeu32-be
5.18+ #:write64-le #:writeu64-le #:write64-be #:writeu64-be
5.19+ #:write128-le #:writeu128-le #:write128-be #:writeu128-be
5.20+ #:read8 #:readu8
5.21+ #:read8-le #:readu8-le #:read8-be #:readu8-be
5.22+ #:read16-le #:readu16-le #:read16-be #:readu16-be
5.23+ #:read32-le #:readu32-le #:read32-be #:readu32-be
5.24+ #:read64-le #:readu64-le #:read64-be #:readu64-be
5.25+ #:read128-le #:readu128-le #:read128-be #:readu128-be
5.26+ #:fast-output-stream #:fast-input-stream))
5.27+
5.28 (defpackage :io/ring
5.29 (:use :cl :uring :io/proto)
5.30 (:import-from :sb-alien :addr)
7.1--- a/lisp/lib/obj/music/music.lisp Tue Oct 01 22:29:08 2024 -0400
7.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
7.3@@ -1,266 +0,0 @@
7.4-;;; music.lisp --- Musical Lisp Systems
7.5-;; inspired by CLM (Stanford CCRMA)
7.6-;;
7.7-;; see also: http://www.titanmusic.com/papers/public/mips20010910.pdf
7.8-;;
7.9-;; refs: https://openmusictheory.github.io/
7.10-;; https://mlochbaum.github.io/BQN-Musician/index.html
7.11-
7.12-;;; Code:
7.13-(in-package :obj/music)
7.14-
7.15-;;; unicode char support
7.16-(defvar *flat-char* #\MUSIC_FLAT_SIGN) ;; ♭
7.17-(defvar *sharp-char* #\MUSIC_SHARP_SIGN) ;; ♯
7.18-(defvar *natural-char* #\MUSIC_NATURAL_SIGN) ;; ♮
7.19-
7.20-;;; amp/db/adb
7.21-(defmacro db-to-amp (db)
7.22- `(expt 10 (/ ,db 20)))
7.23-
7.24-(defmacro amp-to-db (amp)
7.25- `(* 20 (log ,amp 10)))
7.26-
7.27-(defmacro vol-to-amp (v &key (max 1000))
7.28- (let ((vol (gensym)))
7.29- `(let ((,vol ,v))
7.30- (if (<= ,vol 0) 0 (db-to-amp (* -10 (log (/ ,max ,vol) 2)))))))
7.31-
7.32-;; the 96.3296 figure for max is from track-rms.ins
7.33-(defmacro adb-to-amp (adb &key (max 96.3296))
7.34- (let ((db (gensym)))
7.35- `(let ((,db ,adb))
7.36- (if (<= ,db 0.0) 0.0 (db-to-amp (- (abs ,db) ,max))))))
7.37-
7.38-(defmacro amp-to-adb (amp &key (max 96.3296))
7.39- `(if (<= ,amp .00001526) 0.0 (+ ,max (amp-to-db ,amp))))
7.40-
7.41-;;; Tones
7.42-
7.43-;; reading more on this, tones can be simple or complex. Here we deal
7.44-;; with simple tones. A 'pitch' on the other hand, is the perceived
7.45-;; representation of a tone or complex tones. Multiple sets of tones
7.46-;; can share the same 'pitch'.
7.47-
7.48-;; In CLM, pitches are based on C0, compared to A4
7.49-;; which is the norm. I think it makes quite a bit of sense from a
7.50-;; technical standpoint, but with notes that low it becomes very
7.51-;; difficult to hear the differences between tunings.
7.52-
7.53-;; This is Lisp after all though, so the correct implementation should
7.54-;; support tuning by ear based on any note in the *PITCH-TABLE*.
7.55-
7.56-;; Ideally we get smart with it.
7.57-;; NOTE: chroma,morph,chromamorph,genus equivalence across oct
7.58-
7.59-(defvar *c0-default* 16.35160)
7.60-
7.61-;;; Ideally pitch-sets are vectors with a lookup table for
7.62-;;; strings/symbols
7.63-(eval-always
7.64- (defvar *pitch-table* (make-hash-table :test #'equal)))
7.65-
7.66-;; (defmacro define-pitch (name octave interval &key (table *pitch-table*) (c0 *c0-default*))
7.67-;; ;; TODO
7.68-;; ;; (declare (ignore idx))
7.69-;; `(let ((pitch (* ,c0 (expt 2.0 (+ ,octave (/ ,interval 12.0))))))
7.70-;; (setf (gethash ,(symbol-name name) ,table) pitch)))
7.71-
7.72-;; (define-pitch c0 0 0)
7.73-;; (define-pitch cs0 0 1)
7.74-;; (define-pitch df0 0 1)
7.75-;; (define-pitch d0 0 2)
7.76-;; (define-pitch ds0 0 3)
7.77-;; (define-pitch ef0 0 3)
7.78-;; (define-pitch e0 0 4)
7.79-;; (define-pitch ff0 0 4)
7.80-;; (define-pitch f0 0 5)
7.81-;; (define-pitch es0 0 5)
7.82-;; (define-pitch fs0 0 6)
7.83-;; (define-pitch gf0 0 6)
7.84-;; (define-pitch g0 0 7)
7.85-;; (define-pitch gs0 0 8)
7.86-;; (define-pitch af0 0 8)
7.87-;; (define-pitch a0 0 9)
7.88-;; (define-pitch as0 0 10)
7.89-;; (define-pitch bf0 0 10)
7.90-;; (define-pitch b0 0 11)
7.91-;; (define-pitch cf0 0 -1)
7.92-;; (define-pitch bs0 0 12)
7.93-
7.94-;; (define-pitch c1 1 0)
7.95-;; (define-pitch cs1 1 1)
7.96-;; (define-pitch df1 1 1)
7.97-;; (define-pitch d1 1 2)
7.98-;; (define-pitch ds1 1 3)
7.99-;; (define-pitch ef1 1 3)
7.100-;; (define-pitch e1 1 4)
7.101-;; (define-pitch ff1 1 4)
7.102-;; (define-pitch f1 1 5)
7.103-;; (define-pitch es1 1 5)
7.104-;; (define-pitch fs1 1 6)
7.105-;; (define-pitch gf1 1 6)
7.106-;; (define-pitch g1 1 7)
7.107-;; (define-pitch gs1 1 8)
7.108-;; (define-pitch af1 1 8)
7.109-;; (define-pitch a1 1 9)
7.110-;; (define-pitch as1 1 10)
7.111-;; (define-pitch bf1 1 10)
7.112-;; (define-pitch b1 1 11)
7.113-;; (define-pitch cf1 1 -1)
7.114-;; (define-pitch bs1 1 12)
7.115-
7.116-;; (define-pitch c2 2 0)
7.117-;; (define-pitch cs2 2 1)
7.118-;; (define-pitch df2 2 1)
7.119-;; (define-pitch d2 2 2)
7.120-;; (define-pitch ds2 2 3)
7.121-;; (define-pitch ef2 2 3)
7.122-;; (define-pitch e2 2 4)
7.123-;; (define-pitch ff2 2 4)
7.124-;; (define-pitch f2 2 5)
7.125-;; (define-pitch es2 2 5)
7.126-;; (define-pitch fs2 2 6)
7.127-;; (define-pitch gf2 2 6)
7.128-;; (define-pitch g2 2 7)
7.129-;; (define-pitch gs2 2 8)
7.130-;; (define-pitch af2 2 8)
7.131-;; (define-pitch a2 2 9)
7.132-;; (define-pitch as2 2 10)
7.133-;; (define-pitch bf2 2 10)
7.134-;; (define-pitch b2 2 11)
7.135-;; (define-pitch cf2 2 -1)
7.136-;; (define-pitch bs2 2 12)
7.137-
7.138-;; (define-pitch c3 3 0)
7.139-;; (define-pitch cs3 3 1)
7.140-;; (define-pitch df3 3 1)
7.141-;; (define-pitch d3 3 2)
7.142-;; (define-pitch ds3 3 3)
7.143-;; (define-pitch ef3 3 3)
7.144-;; (define-pitch e3 3 4)
7.145-;; (define-pitch ff3 3 4)
7.146-;; (define-pitch f3 3 5)
7.147-;; (define-pitch es3 3 5)
7.148-;; (define-pitch fs3 3 6)
7.149-;; (define-pitch gf3 3 6)
7.150-;; (define-pitch g3 3 7)
7.151-;; (define-pitch gs3 3 8)
7.152-;; (define-pitch af3 3 8)
7.153-;; (define-pitch a3 3 9)
7.154-;; (define-pitch as3 3 10)
7.155-;; (define-pitch bf3 3 10)
7.156-;; (define-pitch b3 3 11)
7.157-;; (define-pitch cf3 3 -1)
7.158-;; (define-pitch bs3 3 12)
7.159-
7.160-;; (define-pitch c4 4 0)
7.161-;; (define-pitch cs4 4 1)
7.162-;; (define-pitch df4 4 1)
7.163-;; (define-pitch d4 4 2)
7.164-;; (define-pitch ds4 4 3)
7.165-;; (define-pitch ef4 4 3)
7.166-;; (define-pitch e4 4 4)
7.167-;; (define-pitch ff4 4 4)
7.168-;; (define-pitch f4 4 5)
7.169-;; (define-pitch es4 4 5)
7.170-;; (define-pitch fs4 4 6)
7.171-;; (define-pitch gf4 4 6)
7.172-;; (define-pitch g4 4 7)
7.173-;; (define-pitch gs4 4 8)
7.174-;; (define-pitch af4 4 8)
7.175-;; (define-pitch a4 4 9)
7.176-;; (define-pitch as4 4 10)
7.177-;; (define-pitch bf4 4 10)
7.178-;; (define-pitch b4 4 11)
7.179-;; (define-pitch cf4 4 -1)
7.180-;; (define-pitch bs4 4 12)
7.181-
7.182-;; (define-pitch c5 5 0)
7.183-;; (define-pitch cs5 5 1)
7.184-;; (define-pitch df5 5 1)
7.185-;; (define-pitch d5 5 2)
7.186-;; (define-pitch ds5 5 3)
7.187-;; (define-pitch ef5 5 3)
7.188-;; (define-pitch e5 5 4)
7.189-;; (define-pitch ff5 5 4)
7.190-;; (define-pitch f5 5 5)
7.191-;; (define-pitch es5 5 5)
7.192-;; (define-pitch fs5 5 6)
7.193-;; (define-pitch gf5 5 6)
7.194-;; (define-pitch g5 5 7)
7.195-;; (define-pitch gs5 5 8)
7.196-;; (define-pitch af5 5 8)
7.197-;; (define-pitch a5 5 9)
7.198-;; (define-pitch as5 5 10)
7.199-;; (define-pitch bf5 5 10)
7.200-;; (define-pitch b5 5 11)
7.201-;; (define-pitch cf5 5 -1)
7.202-;; (define-pitch bs5 5 12)
7.203-
7.204-;; (define-pitch c6 6 0)
7.205-;; (define-pitch cs6 6 1)
7.206-;; (define-pitch df6 6 1)
7.207-;; (define-pitch d6 6 2)
7.208-;; (define-pitch ds6 6 3)
7.209-;; (define-pitch ef6 6 3)
7.210-;; (define-pitch e6 6 4)
7.211-;; (define-pitch ff6 6 4)
7.212-;; (define-pitch f6 6 5)
7.213-;; (define-pitch es6 6 5)
7.214-;; (define-pitch fs6 6 6)
7.215-;; (define-pitch gf6 6 6)
7.216-;; (define-pitch g6 6 7)
7.217-;; (define-pitch gs6 6 8)
7.218-;; (define-pitch af6 6 8)
7.219-;; (define-pitch a6 6 9)
7.220-;; (define-pitch as6 6 10)
7.221-;; (define-pitch bf6 6 10)
7.222-;; (define-pitch b6 6 11)
7.223-;; (define-pitch cf6 6 -1)
7.224-;; (define-pitch bs6 6 12)
7.225-
7.226-;; (define-pitch c7 7 0)
7.227-;; (define-pitch cs7 7 1)
7.228-;; (define-pitch df7 7 1)
7.229-;; (define-pitch d7 7 2)
7.230-;; (define-pitch ds7 7 3)
7.231-;; (define-pitch ef7 7 3)
7.232-;; (define-pitch e7 7 4)
7.233-;; (define-pitch ff7 7 4)
7.234-;; (define-pitch f7 7 5)
7.235-;; (define-pitch es7 7 5)
7.236-;; (define-pitch fs7 7 6)
7.237-;; (define-pitch gf7 7 6)
7.238-;; (define-pitch g7 7 7)
7.239-;; (define-pitch gs7 7 8)
7.240-;; (define-pitch af7 7 8)
7.241-;; (define-pitch a7 7 9)
7.242-;; (define-pitch as7 7 10)
7.243-;; (define-pitch bf7 7 10)
7.244-;; (define-pitch b7 7 11)
7.245-;; (define-pitch cf7 7 -1)
7.246-;; (define-pitch bs7 7 12)
7.247-
7.248-;; (define-pitch c8 8 0)
7.249-;; (define-pitch cs8 8 1)
7.250-;; (define-pitch df8 8 1)
7.251-;; (define-pitch d8 8 2)
7.252-;; (define-pitch ds8 8 3)
7.253-;; (define-pitch ef8 8 3)
7.254-;; (define-pitch e8 8 4)
7.255-;; (define-pitch ff8 8 4)
7.256-;; (define-pitch f8 8 5)
7.257-;; (define-pitch es8 8 5)
7.258-;; (define-pitch fs8 8 6)
7.259-;; (define-pitch gf8 8 6)
7.260-;; (define-pitch g8 8 7)
7.261-;; (define-pitch gs8 8 8)
7.262-;; (define-pitch af8 8 8)
7.263-;; (define-pitch a8 8 9)
7.264-;; (define-pitch as8 8 10)
7.265-;; (define-pitch bf8 8 10)
7.266-;; (define-pitch b8 8 11)
7.267-;; (define-pitch cf8 8 -1)
7.268-;; (define-pitch bs8 8 12)
7.269-
9.1--- a/lisp/lib/skel/core/pkg.lisp Tue Oct 01 22:29:08 2024 -0400
9.2+++ b/lisp/lib/skel/core/pkg.lisp Tue Oct 01 23:34:01 2024 -0400
9.3@@ -9,14 +9,12 @@
9.4 :skel-io-error
9.5 :skel-compile-error))
9.6
9.7-(defpackage :skel/core/types
9.8- (:use :cl :std)
9.9- (:export :vc-designator :license-designator :script-designator
9.10- :contact-designator))
9.11-
9.12 (defpackage :skel/core/proto
9.13 (:use :cl :std)
9.14 (:export
9.15+ ;; types
9.16+ :vc-designator :license-designator :script-designator :contact-designator
9.17+ ;; generics
9.18 :sk-run :sk-new
9.19 :sk-tangle :sk-weave
9.20 :sk-call :sk-call*
9.21@@ -53,7 +51,7 @@
9.22 :make-shebang-comment))
9.23
9.24 (defpackage :skel/core/vars
9.25- (:use :cl :std :skel/core/types)
9.26+ (:use :cl :std :skel/core/proto)
9.27 (:import-from :sb-unix :uid-username :unix-getuid)
9.28 (:export :*user-skelrc* :*system-skelrc* :*keep-ast*
9.29 :*skel-project* :*default-skelrc*
9.30@@ -64,7 +62,7 @@
9.31
9.32 (defpackage :skel/core/obj
9.33 (:use :cl :std :obj
9.34- :skel/core/proto :skel/core/err :skel/core/types :skel/core/vars
9.35+ :skel/core/proto :skel/core/err :skel/core/vars
9.36 :dat/sxp :skel/core/header :vc :log)
9.37 (:import-from :uiop :ensure-absolute-pathname :read-file-forms)
9.38 (:export :sk-license :sk-author :sk-stash :sk-cache :sk-registry :sk-user
9.39@@ -139,6 +137,6 @@
9.40 :init-skel-function-scope))
9.41
9.42 (defpackage :skel/core/print
9.43- (:use :cl :std :skel/core/err :skel/core/obj :skel/core/types :skel/core/proto :skel/core/vars)
9.44+ (:use :cl :std :skel/core/err :skel/core/obj :skel/core/proto :skel/core/vars)
9.45 (:export
9.46 :*sk-print-dispatch-table*))
10.1--- a/lisp/lib/skel/core/proto.lisp Tue Oct 01 22:29:08 2024 -0400
10.2+++ b/lisp/lib/skel/core/proto.lisp Tue Oct 01 23:34:01 2024 -0400
10.3@@ -1,6 +1,19 @@
10.4 ;;; Proto
10.5 (in-package :skel/core/proto)
10.6
10.7+(deftype vc-designator () `(member :hg :git list))
10.8+
10.9+;; ref: https://spdx.org/licenses/
10.10+(deftype license-designator () `(or null string pathname (member :mpl2 :wtfpl :lgpg :llgpl :gpl :mit :mit0)))
10.11+
10.12+(deftype script-designator () '(member :bin :sh :bash :zsh :nu :lisp :python))
10.13+
10.14+(deftype document-designator () '(member :org :txt :pdf :html :md))
10.15+
10.16+(deftype stack-slot-kind () '(member :shell :lisp :comment :var :rule :directive :nop))
10.17+
10.18+(deftype contact-designator () '(or string (cons string string)))
10.19+
10.20 (defgeneric sk-run (self)
10.21 (:documentation "Run the object SELF."))
10.22 (defgeneric sk-new (self &rest args &key &allow-other-keys)
11.1--- a/lisp/lib/skel/core/types.lisp Tue Oct 01 22:29:08 2024 -0400
11.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
11.3@@ -1,14 +0,0 @@
11.4-(in-package :skel/core/types)
11.5-
11.6-(deftype vc-designator () `(member :hg :git list))
11.7-
11.8-;; ref: https://spdx.org/licenses/
11.9-(deftype license-designator () `(or null string pathname (member :mpl2 :wtfpl :lgpg :llgpl :gpl :mit :mit0)))
11.10-
11.11-(deftype script-designator () '(member :bin :sh :bash :zsh :nu :lisp :python))
11.12-
11.13-(deftype document-designator () '(member :org :txt :pdf :html :md))
11.14-
11.15-(deftype stack-slot-kind () '(member :shell :lisp :comment :var :rule :directive :nop))
11.16-
11.17-(deftype contact-designator () '(or string (cons string string)))
12.1--- a/lisp/lib/skel/pkg.lisp Tue Oct 01 22:29:08 2024 -0400
12.2+++ b/lisp/lib/skel/pkg.lisp Tue Oct 01 23:34:01 2024 -0400
12.3@@ -32,9 +32,8 @@
12.4 ;;; Code:
12.5 (pkg:defpkg :skel/core
12.6 (:use :cl :std)
12.7- (:use-reexport :skel/core/err :skel/core/types :skel/core/proto
12.8- :skel/core/vars :skel/core/header :skel/core/obj :skel/core/util
12.9- :skel/core/vm :dat/sxp))
12.10+ (:use-reexport :skel/core/err :skel/core/proto :skel/core/vars
12.11+ :skel/core/header :skel/core/obj :skel/core/util :skel/core/vm :dat/sxp))
12.12
12.13 (pkg:defpkg :skel/comp
12.14 (:use :cl :std)
13.1--- a/lisp/lib/skel/skel.asd Tue Oct 01 22:29:08 2024 -0400
13.2+++ b/lisp/lib/skel/skel.asd Tue Oct 01 23:34:01 2024 -0400
13.3@@ -16,7 +16,6 @@
13.4 :components
13.5 ((:file "pkg")
13.6 (:file "err")
13.7- (:file "types")
13.8 (:file "proto")
13.9 (:file "header")
13.10 (:file "vars")
