;;;; util.lisp -- some utilities ;; Copyright (C) 2022 Colin Okay ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU Affero General Public License as ;; published by the Free Software Foundation, either version 3 of the ;; License, or (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU Affero General Public License for more details. ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see . (in-package :oneliners.api) (defun plist-find (indicator plist &key (test 'eq) (key 'identity)) (loop for (ind val . more) on plist by #'cddr when (funcall test indicator (funcall key ind)) return val)) (defmacro with-plist ((&rest keys) plist &rest body) (let ((the-plist (gensym))) `(let ((,the-plist ,plist)) (let ,(loop for key in keys collect `(,key (plist-find (symbol-name ',key) ,the-plist :test #'string-equal :key #'symbol-name))) ,@body)))) (defclass queue-buffer () ((front :initform (list)) (back :initform (list)) (size :initform 0) (capacity :initarg :capacity))) (defun make-qb (capacity) (make-instance 'queue-buffer :capacity capacity)) (defun qb-empty-p (q) (zerop (slot-value q 'size))) (defun qb-full-p (q) (= (slot-value q 'size) (slot-value q 'capacity))) (defun enqueue-qb (q x) (when (qb-full-p q) (dequeue-qb q)) (with-slots (size back) q (push x back) (incf size))) (defun dequeue-qb (q &optional default) (with-slots (front back size) q (cond ((plusp size) (when (null front) (setf front (nreverse back) back nil)) (decf size) (pop front)) (t default)))) (defun qb-look (q &key limit reversep) "Get a list of the queue, but don't remove items from it. REVERSEP, when T, Puts the newest items first." ;TODO: an inefficient but straightforward implementation, possibly improve. (with-slots (front back) q (let ((seq (if reversep (nconc (copy-seq back) (reverse front)) (nconc (copy-seq front) (reverse back))))) (if limit (a:subseq* seq 0 limit) seq))))