# HG changeset patch # User Richard Westhaver # Date 1727840041 14400 # Node ID 90417ae14b210c63008abdd135e74b258af2b29b # Parent 2e7d93b892a5586e8faee447a53e0ac4b83a06f1 added io/fast, moved obj/music -> aud/music diff -r 2e7d93b892a5 -r 90417ae14b21 emacs/default.el --- a/emacs/default.el Tue Oct 01 22:29:08 2024 -0400 +++ b/emacs/default.el Tue Oct 01 23:34:01 2024 -0400 @@ -369,21 +369,25 @@ ;; :ensure t ;; :config ;; (setq graphviz-dot-indent-width 2)) + ;;; Comments (defcustom prog-comment-keywords '("TODO" "REVIEW" "FIX" "HACK" "RESEARCH") "List of strings with comment keywords." - :group 'default) + :group 'default + :type 'list) (defcustom prog-comment-timestamp-format-concise "%F" "Specifier for date in `prog-comment-timestamp-keyword'. Refer to the doc string of `format-time-string' for the available options." - :group 'default) + :group 'default + :type 'string) (defcustom prog-comment-timestamp-format-verbose "%F %T %z" "Like `prog-comment-timestamp-format-concise', but longer." - :group 'default) + :group 'default + :type 'string) ;;;###autoload (defun prog-comment-dwim (arg) @@ -570,7 +574,8 @@ ;;; Scratch (defcustom default-scratch-buffer-mode 'lisp-interaction-mode "Default major mode for new scratch buffers" - :group 'default) + :group 'default + :type 'symbol) ;; Adapted from the `scratch.el' package by Ian Eure. (defun default-scratch-list-modes () diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/aud/pkg.lisp --- a/lisp/lib/aud/pkg.lisp Tue Oct 01 22:29:08 2024 -0400 +++ b/lisp/lib/aud/pkg.lisp Tue Oct 01 23:34:01 2024 -0400 @@ -1,5 +1,8 @@ (defpackage :aud - (:use :cl :std :dat/midi :obj/music :sndfile :alsa)) + (:use :cl :std :dat/midi :sndfile :alsa)) + +(defpackage :aud/music + (:use :cl :std :aud)) (defpackage :aud/mpd (:use :cl :std :sb-bsd-sockets :net/core :net/util) diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/io/fast.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/lib/io/fast.lisp Tue Oct 01 23:34:01 2024 -0400 @@ -0,0 +1,468 @@ +;;; fast.lisp --- Fast Octet Streams + +;; based on https://github.com/rpav/fast-io/tree/master + +;;; Code: +(in-package :io/fast) + + ;; Vector buffer + +(defvar *default-output-buffer-size* 16) + +(declaim (ftype (function (array-index) octet-vector) make-octet-vector) + (inline make-octet-vector)) +(defun make-octet-vector (len) + (make-array (the array-index len) :element-type 'octet)) + +(declaim (inline output-buffer-vector output-buffer-fill output-buffer-len)) +(defstruct output-buffer + (vector (make-octet-vector *default-output-buffer-size*) + :type octet-vector) + (fill 0 :type array-index) + (len 0 :type array-index) + (queue nil :type list) + (last nil :type list) + (output nil)) + +(defstruct input-buffer + (vector nil :type (or null octet-vector)) + (pos 0 :type array-index) + (stream nil)) + +(defun buffer-position (buffer) + "Return the number of bytes read (for an INPUT-BUFFER) or written + (for an OUTPUT-BUFFER)" + (etypecase buffer + (input-buffer (input-buffer-pos buffer)) + (output-buffer (output-buffer-len buffer)))) + +;; Sometimes it is usefull just to skip the buffer instead of reading from it. +(defun (setf buffer-position) (new-pos buffer) + "Set the buffer position for input-buffer" + (check-type buffer input-buffer) + (let* ((pos (input-buffer-pos buffer)) + (vec (input-buffer-vector buffer)) + (vec-len (length vec))) + (declare (optimize (speed 3) (safety 1)) + (type octet-vector vec) + (type non-negative-fixnum pos vec-len new-pos)) + ;; Only need to update if pos or new-pos is in stream range. + (when-let ((stream-update-needed? (or (> pos vec-len) + (> new-pos vec-len))) + (stream (input-buffer-stream buffer))) + (let* ((stream-file-pos (file-position stream)) + (pos-diff (- new-pos pos)) + (stream-diff (cond ((and (> pos vec-len) + (< new-pos vec-len)) + ;; branch for pos in stream and new-pos + ;; is in vector. + (- vec-len pos)) + ((and (< pos vec-len) + (> new-pos vec-len)) + ;; branch for pos in vector. and new-pos + ;; is in stream. + (- pos-diff (- vec-len pos))) + ;; otherwise stream-diff = pos-diff. + (t pos-diff))) + (new-stream-pos (+ stream-file-pos stream-diff))) + (declare (type non-negative-fixnum stream-file-pos new-stream-pos) + (type fixnum pos-diff stream-diff)) + (file-position stream new-stream-pos)))) + (setf (slot-value buffer 'pos) new-pos)) + +(defun octets-from (sequence) + (let ((vec (make-octet-vector (length sequence)))) + (replace vec sequence) + vec)) + +(defun concat-buffer (buffer) + (let* ((len (output-buffer-len buffer)) + (array + #+fast-io-sv + (if (eq :static (output-buffer-output buffer)) + (static-vectors:make-static-vector (the array-index len)) + (make-octet-vector len)) + #-fast-io-sv + (make-octet-vector len))) + (loop as i = 0 then (+ i (length a)) + for a in (output-buffer-queue buffer) do + (replace (the octet-vector array) + (the octet-vector a) :start1 i) + finally + (replace (the octet-vector array) + (output-buffer-vector buffer) + :start1 i + :end2 (output-buffer-fill buffer))) + array)) + +(defun flush (output-buffer) + (when (> (output-buffer-fill output-buffer) 0) + (write-sequence (output-buffer-vector output-buffer) + (output-buffer-output output-buffer) + :start 0 :end (output-buffer-fill output-buffer)) + (prog1 (output-buffer-fill output-buffer) + (setf (output-buffer-fill output-buffer) 0)))) + +(defun extend (buffer &optional (min 1)) + (let ((vector (output-buffer-vector buffer))) + (setf (output-buffer-last buffer) + (nconc (output-buffer-last buffer) + (cons vector nil)) + (output-buffer-vector buffer) + (make-octet-vector (max min (1+ (* 2 (length vector))))) + (output-buffer-fill buffer) 0) + (unless (output-buffer-queue buffer) + (setf (output-buffer-queue buffer) + (output-buffer-last buffer))))) + +(defun fast-write-byte (byte output-buffer) + (declare (type octet byte) + (type output-buffer output-buffer) + (optimize (speed 3) (safety 1))) + (when (= (output-buffer-fill output-buffer) + (array-dimension (output-buffer-vector output-buffer) 0)) + (if (streamp (output-buffer-output output-buffer)) + (flush output-buffer) + (extend output-buffer))) + (prog1 + (setf (aref (output-buffer-vector output-buffer) + (output-buffer-fill output-buffer)) + byte) + (incf (output-buffer-fill output-buffer)) + (incf (output-buffer-len output-buffer)))) + +(defun fast-read-byte (input-buffer &optional (eof-error-p t) eof-value) + (declare (type input-buffer input-buffer)) + (when-let ((vec (input-buffer-vector input-buffer)) + (pos (input-buffer-pos input-buffer))) + (when (< pos (length vec)) + (incf (input-buffer-pos input-buffer)) + (return-from fast-read-byte (aref vec pos)))) + (when-let ((stream (input-buffer-stream input-buffer))) + (let ((byte (read-byte stream eof-error-p eof-value))) + (unless (equal byte eof-value) + (incf (input-buffer-pos input-buffer))) + (return-from fast-read-byte byte))) + (if eof-error-p + (error 'end-of-file :stream input-buffer) + eof-value)) + +(defun fast-peek-byte (input-buffer &optional peek-type (eof-error-p t) eof-value) + "This is like `peek-byte' only for fast-io input-buffers." + (declare (type input-buffer input-buffer)) + (loop :for octet = (fast-read-byte input-buffer eof-error-p :eof) + :for new-pos :from (input-buffer-pos input-buffer) + :until (cond ((eq octet :eof) + (return eof-value)) + ((null peek-type)) + ((eq peek-type 't) + (plusp octet)) + ((= octet peek-type))) + :finally (setf (buffer-position input-buffer) new-pos) + (return octet))) + +(defun fast-write-sequence (sequence output-buffer &optional (start 0) end) + (if (streamp (output-buffer-output output-buffer)) + (progn + (flush output-buffer) + (write-sequence sequence (output-buffer-output output-buffer) :start start :end end)) + (progn + (let* ((start2 start) + (len (if end + (- end start) + (- (length sequence) start))) + (buffer-remaining + (- (length (output-buffer-vector output-buffer)) + (output-buffer-fill output-buffer)))) + (when (> buffer-remaining 0) + (replace (output-buffer-vector output-buffer) + (the octet-vector sequence) + :start1 (output-buffer-fill output-buffer) + :start2 start2 + :end2 end) + (incf start2 buffer-remaining) + (incf (output-buffer-fill output-buffer) + (min buffer-remaining len))) + (let ((sequence-remaining (- (or end (length sequence)) start2))) + (when (> sequence-remaining 0) + (extend output-buffer sequence-remaining) + (replace (output-buffer-vector output-buffer) + (the octet-vector sequence) + :start2 start2 + :end2 end) + (incf (output-buffer-fill output-buffer) sequence-remaining))) + (incf (output-buffer-len output-buffer) len) + len)))) + +(defun fast-read-sequence (sequence input-buffer &optional (start 0) end) + (declare (type octet-vector sequence) + (type input-buffer input-buffer)) + (let ((start1 start) + (total-len (if end + (- end start) + (- (length sequence) start)))) + (when-let ((vec (input-buffer-vector input-buffer)) + (pos (input-buffer-pos input-buffer))) + (when (< pos (length vec)) + (let ((len (min total-len (- (length vec) pos)))) + (replace sequence vec + :start1 start1 + :start2 pos + :end2 (+ pos len)) + (incf (input-buffer-pos input-buffer) len) + (incf start1 len)))) + (when (< start1 total-len) + (when-let ((stream (input-buffer-stream input-buffer))) + (let ((bytes-read (read-sequence sequence stream + :start start1 + :end (+ total-len start1)))) + (incf (input-buffer-pos input-buffer) bytes-read) + (return-from fast-read-sequence bytes-read)))) + start1)) + +(defun finish-output-buffer (output-buffer) + "Finish an output buffer. If it is backed by a vector (static or otherwise) +it returns the final octet vector. If it is backed by a stream it ensures that +all data has been flushed to the stream." + (if (streamp (output-buffer-output output-buffer)) + (flush output-buffer) + (concat-buffer output-buffer))) + +(defmacro with-fast-output ((buffer &optional output) &body body) + "Create `BUFFER`, optionally outputting to `OUTPUT`." + `(let ((,buffer (make-output-buffer :output ,output))) + ,@body + (if (streamp (output-buffer-output ,buffer)) + (flush ,buffer) + (finish-output-buffer ,buffer)))) + +(defmacro with-fast-input ((buffer vector &optional stream (offset 0)) &body body) + `(let ((,buffer (make-input-buffer :vector ,vector :stream ,stream :pos ,offset))) + ,@body)) + + ;; READx and WRITEx +;;; WRITE-UNSIGNED-BE, READ-UNSIGNED-BE, etc taken from PACK, which is +;;; in the public domain. + +(defmacro write-unsigned-be (value size buffer) + (once-only (value buffer) + `(progn + ,@(loop for i from (* (1- size) 8) downto 0 by 8 + collect `(fast-write-byte (ldb (byte 8 ,i) ,value) ,buffer))))) + +(defmacro read-unsigned-be (size buffer) + (with-gensyms (value) + (once-only (buffer) + `(let ((,value 0)) + ,@(loop for i from (* (1- size) 8) downto 0 by 8 + collect `(setf (ldb (byte 8 ,i) ,value) (fast-read-byte ,buffer))) + ,value)))) + +(defmacro write-unsigned-le (value size buffer) + (once-only (value buffer) + `(progn + ,@(loop for i from 0 below (* 8 size) by 8 + collect `(fast-write-byte (ldb (byte 8 ,i) ,value) ,buffer))))) + +(defmacro read-unsigned-le (size buffer) + (with-gensyms (value) + (once-only (buffer) + `(let ((,value 0)) + ,@(loop for i from 0 below (* 8 size) by 8 + collect `(setf (ldb (byte 8 ,i) ,value) (fast-read-byte ,buffer))) + ,value)))) + +(declaim (inline unsigned-to-signed)) +(defun unsigned-to-signed (value size) + (let ((max-signed (expt 2 (1- (* 8 size)))) + (to-subtract (expt 2 (* 8 size)))) + (if (>= value max-signed) + (- value to-subtract) + value))) + +(declaim (inline signed-to-unsigned)) +(defun signed-to-unsigned (value size) + (if (minusp value) + (+ value (expt 2 (* 8 size))) + value)) + +(defmacro make-readers (&rest bitlens) + (let ((names (mapcar (lambda (n) + (mapcar (lambda (m) (symbolicate (format nil m n))) + '("READ~A-BE" "READU~A-BE" + "READ~A-LE" "READU~A-LE"))) + bitlens))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (declaim (inline ,@(flatten names))) + ,@(loop for fun in names + for bits in bitlens + as bytes = (truncate bits 8) + collect + `(progn + (defun ,(first fun) (buffer) + (unsigned-to-signed (read-unsigned-be ,bytes buffer) ,bytes)) + (defun ,(second fun) (buffer) + (read-unsigned-be ,bytes buffer)) + (defun ,(third fun) (buffer) + (unsigned-to-signed (read-unsigned-le ,bytes buffer) ,bytes)) + (defun ,(fourth fun) (buffer) + (read-unsigned-le ,bytes buffer))))))) + +(defmacro make-writers (&rest bitlens) + (let ((names (mapcar (lambda (n) + (mapcar (lambda (m) (symbolicate (format nil m n))) + '("WRITE~A-BE" "WRITEU~A-BE" + "WRITE~A-LE" "WRITEU~A-LE"))) + bitlens))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (declaim (notinline ,@(flatten names))) + ,@(loop for fun in names + for bits in bitlens + as bytes = (truncate bits 8) + collect + `(progn + (defun ,(first fun) (value buffer) + (declare (type (signed-byte ,bits) value)) + (write-unsigned-be (the (unsigned-byte ,bits) + (signed-to-unsigned value ,bytes)) ,bytes buffer)) + (defun ,(second fun) (value buffer) + (declare (type (unsigned-byte ,bits) value)) + (write-unsigned-be (the (unsigned-byte ,bits) value) + ,bytes buffer)) + (defun ,(third fun) (value buffer) + (declare (type (signed-byte ,bits) value)) + (write-unsigned-le (the (unsigned-byte ,bits) + (signed-to-unsigned value ,bytes)) ,bytes buffer)) + (defun ,(fourth fun) (value buffer) + (declare (type (unsigned-byte ,bits) value)) + (write-unsigned-le (the (unsigned-byte ,bits) value) + ,bytes buffer))))))) + +(make-writers 16 24 32 64 128) +(make-readers 16 24 32 64 128) + +(declaim (inline write8 writeu8 read8 readu8)) +(defun write8 (value buffer) + (declare (type (signed-byte 8) value)) + (fast-write-byte (signed-to-unsigned value 1) buffer)) + +(defun writeu8 (value buffer) + (declare (type (unsigned-byte 8) value)) + (fast-write-byte value buffer)) + + +(defun read8 (buffer) + (unsigned-to-signed (fast-read-byte buffer) 1)) + +(defun readu8 (buffer) + (fast-read-byte buffer)) + +(setf (symbol-function 'write8-le) #'write8) +(setf (symbol-function 'write8-be) #'write8) +(setf (symbol-function 'writeu8-le) #'writeu8) +(setf (symbol-function 'writeu8-be) #'writeu8) + +(setf (symbol-function 'read8-le) #'read8) +(setf (symbol-function 'read8-be) #'read8) +(setf (symbol-function 'readu8-le) #'readu8) +(setf (symbol-function 'readu8-be) #'readu8) + +;; fast-stream + +(defclass fast-io-stream (fundamental-stream) + ((openp :type boolean :initform t))) + +(defmethod stream-file-position ((stream fast-io-stream)) + (with-slots (buffer) stream + (buffer-position buffer))) + +(defmethod open-stream-p ((stream fast-io-stream)) + (slot-value stream 'openep)) + + ;; fast-output-stream + +(defclass fast-output-stream (fast-io-stream fundamental-output-stream) + ((buffer :type output-buffer))) + +(defmethod initialize-instance ((self fast-output-stream) &key stream + buffer-size &allow-other-keys) + (call-next-method) + (let ((*default-output-buffer-size* (or buffer-size *default-output-buffer-size*))) + (with-slots (buffer) self + (setf buffer (make-output-buffer :output stream))))) + +(defmethod output-stream-p ((stream fast-output-stream)) + (with-slots (buffer) stream + (and (typep buffer 'output-buffer)))) + +(defmethod stream-element-type ((stream fast-output-stream)) + "Return the underlying array element-type. + Should always return '(unsigned-byte 8)." + (with-slots (buffer) stream + (array-element-type (output-buffer-vector buffer)))) + +(defmethod stream-write-byte ((stream fast-output-stream) byte) + (with-slots (buffer) stream + (fast-write-byte byte buffer))) + +(defmethod stream-write-sequence ((stream fast-output-stream) sequence start end + &key &allow-other-keys) + (with-slots (buffer) stream + (fast-write-sequence sequence buffer start end)) + sequence) + +(defun finish-output-stream (stream) + (with-slots (buffer) stream + (if (streamp (output-buffer-output buffer)) + (flush buffer) + (finish-output-buffer buffer)))) + +(defmethod close ((stream fast-output-stream) &key abort) + (declare (ignore abort)) + (finish-output-stream stream) + (setf (slot-value stream 'openp) nil)) + + ;; fast-input-stream + +(defclass fast-input-stream (fast-io-stream fundamental-input-stream) + ((buffer :type input-buffer))) + +(defmethod initialize-instance ((self fast-input-stream) &key stream + vector &allow-other-keys) + (call-next-method) + (with-slots (buffer) self + (setf buffer (make-input-buffer :vector vector :stream stream)))) + +(defmethod input-stream-p ((stream fast-input-stream)) + (with-slots (buffer) stream + (and (typep buffer 'input-buffer)))) + +(defmethod stream-element-type ((stream fast-input-stream)) + "Return element-type of the underlying vector or stream. + Return NIL if none are present." + (with-slots (buffer) stream + (if-let ((vec (input-buffer-vector buffer))) + (array-element-type vec) + (when-let ((stream (input-buffer-stream buffer))) + (stream-element-type stream))))) + +(defmethod (setf stream-file-position) (new-pos (stream fast-input-stream)) + (with-slots (buffer) stream + (setf (buffer-position buffer) new-pos))) + +(defmethod peek-byte ((stream fast-input-stream) &optional peek-type (eof-error-p t) eof-value) + (with-slots (buffer) stream + (fast-peek-byte buffer peek-type eof-error-p eof-value))) + +(defmethod stream-read-byte ((stream fast-input-stream)) + (with-slots (buffer) stream + (fast-read-byte buffer))) + +(defmethod stream-read-sequence ((stream fast-input-stream) sequence start end + &key &allow-other-keys) + (with-slots (buffer) stream + (fast-read-sequence sequence buffer start end))) + +(defmethod close ((stream fast-input-stream) &key abort) + (declare (ignore abort)) + (setf (slot-value stream 'openp) nil)) diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/io/io.asd --- a/lisp/lib/io/io.asd Tue Oct 01 22:29:08 2024 -0400 +++ b/lisp/lib/io/io.asd Tue Oct 01 23:34:01 2024 -0400 @@ -9,6 +9,7 @@ :version "0.1.0" :serial t :components ((:file "pkg") + (:file "fast") (:file "ring" :if-feature :linux) (:file "socket") (:file "stream") diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/io/pkg.lisp --- a/lisp/lib/io/pkg.lisp Tue Oct 01 22:29:08 2024 -0400 +++ b/lisp/lib/io/pkg.lisp Tue Oct 01 23:34:01 2024 -0400 @@ -16,6 +16,27 @@ (:use :cl :std/condition) (:export :io-error)) +(defpackage :io/fast + (:use :cl :std :io/proto) + (:export + #:fast-read-byte #:fast-write-byte + #:fast-read-sequence #:fast-write-sequence + #:with-fast-input #:with-fast-output + #:write8 #:writeu8 + #:write8-le #:writeu8-le #:write8-be #:writeu8-be + #:write16-le #:writeu16-le #:write16-be #:writeu16-be + #:write24-le #:writeu24-le #:write24-be #:writeu24-be + #:write32-le #:writeu32-le #:write32-be #:writeu32-be + #:write64-le #:writeu64-le #:write64-be #:writeu64-be + #:write128-le #:writeu128-le #:write128-be #:writeu128-be + #:read8 #:readu8 + #:read8-le #:readu8-le #:read8-be #:readu8-be + #:read16-le #:readu16-le #:read16-be #:readu16-be + #:read32-le #:readu32-le #:read32-be #:readu32-be + #:read64-le #:readu64-le #:read64-be #:readu64-be + #:read128-le #:readu128-le #:read128-be #:readu128-be + #:fast-output-stream #:fast-input-stream)) + (defpackage :io/ring (:use :cl :uring :io/proto) (:import-from :sb-alien :addr) diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/obj/music/chord.lisp diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/obj/music/music.lisp --- a/lisp/lib/obj/music/music.lisp Tue Oct 01 22:29:08 2024 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,266 +0,0 @@ -;;; music.lisp --- Musical Lisp Systems -;; inspired by CLM (Stanford CCRMA) -;; -;; see also: http://www.titanmusic.com/papers/public/mips20010910.pdf -;; -;; refs: https://openmusictheory.github.io/ -;; https://mlochbaum.github.io/BQN-Musician/index.html - -;;; Code: -(in-package :obj/music) - -;;; unicode char support -(defvar *flat-char* #\MUSIC_FLAT_SIGN) ;; ♭ -(defvar *sharp-char* #\MUSIC_SHARP_SIGN) ;; ♯ -(defvar *natural-char* #\MUSIC_NATURAL_SIGN) ;; ♮ - -;;; amp/db/adb -(defmacro db-to-amp (db) - `(expt 10 (/ ,db 20))) - -(defmacro amp-to-db (amp) - `(* 20 (log ,amp 10))) - -(defmacro vol-to-amp (v &key (max 1000)) - (let ((vol (gensym))) - `(let ((,vol ,v)) - (if (<= ,vol 0) 0 (db-to-amp (* -10 (log (/ ,max ,vol) 2))))))) - -;; the 96.3296 figure for max is from track-rms.ins -(defmacro adb-to-amp (adb &key (max 96.3296)) - (let ((db (gensym))) - `(let ((,db ,adb)) - (if (<= ,db 0.0) 0.0 (db-to-amp (- (abs ,db) ,max)))))) - -(defmacro amp-to-adb (amp &key (max 96.3296)) - `(if (<= ,amp .00001526) 0.0 (+ ,max (amp-to-db ,amp)))) - -;;; Tones - -;; reading more on this, tones can be simple or complex. Here we deal -;; with simple tones. A 'pitch' on the other hand, is the perceived -;; representation of a tone or complex tones. Multiple sets of tones -;; can share the same 'pitch'. - -;; In CLM, pitches are based on C0, compared to A4 -;; which is the norm. I think it makes quite a bit of sense from a -;; technical standpoint, but with notes that low it becomes very -;; difficult to hear the differences between tunings. - -;; This is Lisp after all though, so the correct implementation should -;; support tuning by ear based on any note in the *PITCH-TABLE*. - -;; Ideally we get smart with it. -;; NOTE: chroma,morph,chromamorph,genus equivalence across oct - -(defvar *c0-default* 16.35160) - -;;; Ideally pitch-sets are vectors with a lookup table for -;;; strings/symbols -(eval-always - (defvar *pitch-table* (make-hash-table :test #'equal))) - -;; (defmacro define-pitch (name octave interval &key (table *pitch-table*) (c0 *c0-default*)) -;; ;; TODO -;; ;; (declare (ignore idx)) -;; `(let ((pitch (* ,c0 (expt 2.0 (+ ,octave (/ ,interval 12.0)))))) -;; (setf (gethash ,(symbol-name name) ,table) pitch))) - -;; (define-pitch c0 0 0) -;; (define-pitch cs0 0 1) -;; (define-pitch df0 0 1) -;; (define-pitch d0 0 2) -;; (define-pitch ds0 0 3) -;; (define-pitch ef0 0 3) -;; (define-pitch e0 0 4) -;; (define-pitch ff0 0 4) -;; (define-pitch f0 0 5) -;; (define-pitch es0 0 5) -;; (define-pitch fs0 0 6) -;; (define-pitch gf0 0 6) -;; (define-pitch g0 0 7) -;; (define-pitch gs0 0 8) -;; (define-pitch af0 0 8) -;; (define-pitch a0 0 9) -;; (define-pitch as0 0 10) -;; (define-pitch bf0 0 10) -;; (define-pitch b0 0 11) -;; (define-pitch cf0 0 -1) -;; (define-pitch bs0 0 12) - -;; (define-pitch c1 1 0) -;; (define-pitch cs1 1 1) -;; (define-pitch df1 1 1) -;; (define-pitch d1 1 2) -;; (define-pitch ds1 1 3) -;; (define-pitch ef1 1 3) -;; (define-pitch e1 1 4) -;; (define-pitch ff1 1 4) -;; (define-pitch f1 1 5) -;; (define-pitch es1 1 5) -;; (define-pitch fs1 1 6) -;; (define-pitch gf1 1 6) -;; (define-pitch g1 1 7) -;; (define-pitch gs1 1 8) -;; (define-pitch af1 1 8) -;; (define-pitch a1 1 9) -;; (define-pitch as1 1 10) -;; (define-pitch bf1 1 10) -;; (define-pitch b1 1 11) -;; (define-pitch cf1 1 -1) -;; (define-pitch bs1 1 12) - -;; (define-pitch c2 2 0) -;; (define-pitch cs2 2 1) -;; (define-pitch df2 2 1) -;; (define-pitch d2 2 2) -;; (define-pitch ds2 2 3) -;; (define-pitch ef2 2 3) -;; (define-pitch e2 2 4) -;; (define-pitch ff2 2 4) -;; (define-pitch f2 2 5) -;; (define-pitch es2 2 5) -;; (define-pitch fs2 2 6) -;; (define-pitch gf2 2 6) -;; (define-pitch g2 2 7) -;; (define-pitch gs2 2 8) -;; (define-pitch af2 2 8) -;; (define-pitch a2 2 9) -;; (define-pitch as2 2 10) -;; (define-pitch bf2 2 10) -;; (define-pitch b2 2 11) -;; (define-pitch cf2 2 -1) -;; (define-pitch bs2 2 12) - -;; (define-pitch c3 3 0) -;; (define-pitch cs3 3 1) -;; (define-pitch df3 3 1) -;; (define-pitch d3 3 2) -;; (define-pitch ds3 3 3) -;; (define-pitch ef3 3 3) -;; (define-pitch e3 3 4) -;; (define-pitch ff3 3 4) -;; (define-pitch f3 3 5) -;; (define-pitch es3 3 5) -;; (define-pitch fs3 3 6) -;; (define-pitch gf3 3 6) -;; (define-pitch g3 3 7) -;; (define-pitch gs3 3 8) -;; (define-pitch af3 3 8) -;; (define-pitch a3 3 9) -;; (define-pitch as3 3 10) -;; (define-pitch bf3 3 10) -;; (define-pitch b3 3 11) -;; (define-pitch cf3 3 -1) -;; (define-pitch bs3 3 12) - -;; (define-pitch c4 4 0) -;; (define-pitch cs4 4 1) -;; (define-pitch df4 4 1) -;; (define-pitch d4 4 2) -;; (define-pitch ds4 4 3) -;; (define-pitch ef4 4 3) -;; (define-pitch e4 4 4) -;; (define-pitch ff4 4 4) -;; (define-pitch f4 4 5) -;; (define-pitch es4 4 5) -;; (define-pitch fs4 4 6) -;; (define-pitch gf4 4 6) -;; (define-pitch g4 4 7) -;; (define-pitch gs4 4 8) -;; (define-pitch af4 4 8) -;; (define-pitch a4 4 9) -;; (define-pitch as4 4 10) -;; (define-pitch bf4 4 10) -;; (define-pitch b4 4 11) -;; (define-pitch cf4 4 -1) -;; (define-pitch bs4 4 12) - -;; (define-pitch c5 5 0) -;; (define-pitch cs5 5 1) -;; (define-pitch df5 5 1) -;; (define-pitch d5 5 2) -;; (define-pitch ds5 5 3) -;; (define-pitch ef5 5 3) -;; (define-pitch e5 5 4) -;; (define-pitch ff5 5 4) -;; (define-pitch f5 5 5) -;; (define-pitch es5 5 5) -;; (define-pitch fs5 5 6) -;; (define-pitch gf5 5 6) -;; (define-pitch g5 5 7) -;; (define-pitch gs5 5 8) -;; (define-pitch af5 5 8) -;; (define-pitch a5 5 9) -;; (define-pitch as5 5 10) -;; (define-pitch bf5 5 10) -;; (define-pitch b5 5 11) -;; (define-pitch cf5 5 -1) -;; (define-pitch bs5 5 12) - -;; (define-pitch c6 6 0) -;; (define-pitch cs6 6 1) -;; (define-pitch df6 6 1) -;; (define-pitch d6 6 2) -;; (define-pitch ds6 6 3) -;; (define-pitch ef6 6 3) -;; (define-pitch e6 6 4) -;; (define-pitch ff6 6 4) -;; (define-pitch f6 6 5) -;; (define-pitch es6 6 5) -;; (define-pitch fs6 6 6) -;; (define-pitch gf6 6 6) -;; (define-pitch g6 6 7) -;; (define-pitch gs6 6 8) -;; (define-pitch af6 6 8) -;; (define-pitch a6 6 9) -;; (define-pitch as6 6 10) -;; (define-pitch bf6 6 10) -;; (define-pitch b6 6 11) -;; (define-pitch cf6 6 -1) -;; (define-pitch bs6 6 12) - -;; (define-pitch c7 7 0) -;; (define-pitch cs7 7 1) -;; (define-pitch df7 7 1) -;; (define-pitch d7 7 2) -;; (define-pitch ds7 7 3) -;; (define-pitch ef7 7 3) -;; (define-pitch e7 7 4) -;; (define-pitch ff7 7 4) -;; (define-pitch f7 7 5) -;; (define-pitch es7 7 5) -;; (define-pitch fs7 7 6) -;; (define-pitch gf7 7 6) -;; (define-pitch g7 7 7) -;; (define-pitch gs7 7 8) -;; (define-pitch af7 7 8) -;; (define-pitch a7 7 9) -;; (define-pitch as7 7 10) -;; (define-pitch bf7 7 10) -;; (define-pitch b7 7 11) -;; (define-pitch cf7 7 -1) -;; (define-pitch bs7 7 12) - -;; (define-pitch c8 8 0) -;; (define-pitch cs8 8 1) -;; (define-pitch df8 8 1) -;; (define-pitch d8 8 2) -;; (define-pitch ds8 8 3) -;; (define-pitch ef8 8 3) -;; (define-pitch e8 8 4) -;; (define-pitch ff8 8 4) -;; (define-pitch f8 8 5) -;; (define-pitch es8 8 5) -;; (define-pitch fs8 8 6) -;; (define-pitch gf8 8 6) -;; (define-pitch g8 8 7) -;; (define-pitch gs8 8 8) -;; (define-pitch af8 8 8) -;; (define-pitch a8 8 9) -;; (define-pitch as8 8 10) -;; (define-pitch bf8 8 10) -;; (define-pitch b8 8 11) -;; (define-pitch cf8 8 -1) -;; (define-pitch bs8 8 12) - diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/obj/music/note.lisp diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/skel/core/pkg.lisp --- a/lisp/lib/skel/core/pkg.lisp Tue Oct 01 22:29:08 2024 -0400 +++ b/lisp/lib/skel/core/pkg.lisp Tue Oct 01 23:34:01 2024 -0400 @@ -9,14 +9,12 @@ :skel-io-error :skel-compile-error)) -(defpackage :skel/core/types - (:use :cl :std) - (:export :vc-designator :license-designator :script-designator - :contact-designator)) - (defpackage :skel/core/proto (:use :cl :std) (:export + ;; types + :vc-designator :license-designator :script-designator :contact-designator + ;; generics :sk-run :sk-new :sk-tangle :sk-weave :sk-call :sk-call* @@ -53,7 +51,7 @@ :make-shebang-comment)) (defpackage :skel/core/vars - (:use :cl :std :skel/core/types) + (:use :cl :std :skel/core/proto) (:import-from :sb-unix :uid-username :unix-getuid) (:export :*user-skelrc* :*system-skelrc* :*keep-ast* :*skel-project* :*default-skelrc* @@ -64,7 +62,7 @@ (defpackage :skel/core/obj (:use :cl :std :obj - :skel/core/proto :skel/core/err :skel/core/types :skel/core/vars + :skel/core/proto :skel/core/err :skel/core/vars :dat/sxp :skel/core/header :vc :log) (:import-from :uiop :ensure-absolute-pathname :read-file-forms) (:export :sk-license :sk-author :sk-stash :sk-cache :sk-registry :sk-user @@ -139,6 +137,6 @@ :init-skel-function-scope)) (defpackage :skel/core/print - (:use :cl :std :skel/core/err :skel/core/obj :skel/core/types :skel/core/proto :skel/core/vars) + (:use :cl :std :skel/core/err :skel/core/obj :skel/core/proto :skel/core/vars) (:export :*sk-print-dispatch-table*)) diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/skel/core/proto.lisp --- a/lisp/lib/skel/core/proto.lisp Tue Oct 01 22:29:08 2024 -0400 +++ b/lisp/lib/skel/core/proto.lisp Tue Oct 01 23:34:01 2024 -0400 @@ -1,6 +1,19 @@ ;;; Proto (in-package :skel/core/proto) +(deftype vc-designator () `(member :hg :git list)) + +;; ref: https://spdx.org/licenses/ +(deftype license-designator () `(or null string pathname (member :mpl2 :wtfpl :lgpg :llgpl :gpl :mit :mit0))) + +(deftype script-designator () '(member :bin :sh :bash :zsh :nu :lisp :python)) + +(deftype document-designator () '(member :org :txt :pdf :html :md)) + +(deftype stack-slot-kind () '(member :shell :lisp :comment :var :rule :directive :nop)) + +(deftype contact-designator () '(or string (cons string string))) + (defgeneric sk-run (self) (:documentation "Run the object SELF.")) (defgeneric sk-new (self &rest args &key &allow-other-keys) diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/skel/core/types.lisp --- a/lisp/lib/skel/core/types.lisp Tue Oct 01 22:29:08 2024 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -(in-package :skel/core/types) - -(deftype vc-designator () `(member :hg :git list)) - -;; ref: https://spdx.org/licenses/ -(deftype license-designator () `(or null string pathname (member :mpl2 :wtfpl :lgpg :llgpl :gpl :mit :mit0))) - -(deftype script-designator () '(member :bin :sh :bash :zsh :nu :lisp :python)) - -(deftype document-designator () '(member :org :txt :pdf :html :md)) - -(deftype stack-slot-kind () '(member :shell :lisp :comment :var :rule :directive :nop)) - -(deftype contact-designator () '(or string (cons string string))) diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/skel/pkg.lisp --- a/lisp/lib/skel/pkg.lisp Tue Oct 01 22:29:08 2024 -0400 +++ b/lisp/lib/skel/pkg.lisp Tue Oct 01 23:34:01 2024 -0400 @@ -32,9 +32,8 @@ ;;; Code: (pkg:defpkg :skel/core (:use :cl :std) - (:use-reexport :skel/core/err :skel/core/types :skel/core/proto - :skel/core/vars :skel/core/header :skel/core/obj :skel/core/util - :skel/core/vm :dat/sxp)) + (:use-reexport :skel/core/err :skel/core/proto :skel/core/vars + :skel/core/header :skel/core/obj :skel/core/util :skel/core/vm :dat/sxp)) (pkg:defpkg :skel/comp (:use :cl :std) diff -r 2e7d93b892a5 -r 90417ae14b21 lisp/lib/skel/skel.asd --- a/lisp/lib/skel/skel.asd Tue Oct 01 22:29:08 2024 -0400 +++ b/lisp/lib/skel/skel.asd Tue Oct 01 23:34:01 2024 -0400 @@ -16,7 +16,6 @@ :components ((:file "pkg") (:file "err") - (:file "types") (:file "proto") (:file "header") (:file "vars")