Add rb-clear and (rb-contents ... :result-type 'vector)
author |
Steve Losh <steve@stevelosh.com> |
date |
Sat, 10 Apr 2021 13:26:30 -0400 |
parents |
e9553a14c887
|
children |
25d07c157495
|
branches/tags |
(none) |
files |
src/package.lisp src/ring-buffers.lisp test/base.lisp test/ring-buffers.lisp |
Changes
--- a/src/package.lisp Fri Apr 09 22:54:39 2021 -0400
+++ b/src/package.lisp Sat Apr 10 13:26:30 2021 -0400
@@ -203,6 +203,7 @@
:do-ring-buffer
:make-ring-buffer
+ :rb-clear
:rb-contents
:rb-count
:rb-empty-p
--- a/src/ring-buffers.lisp Fri Apr 09 22:54:39 2021 -0400
+++ b/src/ring-buffers.lisp Sat Apr 10 13:26:30 2021 -0400
@@ -31,6 +31,14 @@
(size ring-buffer)))
+(defun rb-clear (ring-buffer)
+ "Clear the contents of `ring-buffer`."
+ (fill (data ring-buffer) nil)
+ (setf (r ring-buffer) 0
+ (w ring-buffer) 0)
+ nil)
+
+
(defmacro 1+mod ((field ring-buffer))
(once-only (ring-buffer)
(with-gensyms (result)
@@ -55,7 +63,7 @@
(defun rb-push (ring-buffer object)
- "Push `object` into `ring-buffer`.
+ "Push `object` into `ring-buffer` and return `object`.
If `ring-buffer` is full, its oldest element will be silently dropped. If you
want an error to be signaled instead, use `rb-safe-push`.
@@ -140,7 +148,7 @@
(defun rb-contents (ring-buffer &key (result-type 'list))
"Return a fresh sequence of the contents of `ring-buffer` (oldest to newest).
- `result-type` can currently only be `list`. TODO: add `vector`.
+ `result-type` can be `list` or `vector`.
"
(ecase result-type
@@ -151,7 +159,18 @@
:until (= r w)
:collect (svref d r)
:do (incf r)
- :when (= r s) :do (setf r 0)))))
+ :when (= r s) :do (setf r 0)))
+ (vector
+ (let* ((n (rb-count ring-buffer))
+ (result (make-array n))
+ (data (data ring-buffer))
+ (r (r ring-buffer))
+ (w (w ring-buffer)))
+ (if (<= r w)
+ (replace result data :start2 r :end2 w)
+ (progn (replace result data :start2 r)
+ (replace result data :start2 0 :end2 w :start1 (- (size ring-buffer) r))))
+ result))))
;;;; Printing -----------------------------------------------------------------
--- a/test/base.lisp Fri Apr 09 22:54:39 2021 -0400
+++ b/test/base.lisp Sat Apr 10 13:26:30 2021 -0400
@@ -2,7 +2,7 @@
(defmacro define-test (name &body body)
- `(test ,(intern (concatenate 'string (symbol-name 'test-) (symbol-name name)))
+ `(test ,(intern (concatenate 'string (symbol-name 'test/) (symbol-name name)))
(let ((*package* ,*package*))
,@body)))
--- a/test/ring-buffers.lisp Fri Apr 09 22:54:39 2021 -0400
+++ b/test/ring-buffers.lisp Sat Apr 10 13:26:30 2021 -0400
@@ -1,8 +1,12 @@
(in-package :losh.test)
(defun check-ring-buffer (rb expected-contents)
- ;; rb-contents
- (is (equal expected-contents (rb-contents rb)))
+ ;; rb-contents (list)
+ (is (equal (coerce expected-contents 'list)
+ (rb-contents rb :result-type 'list)))
+ ;; rb-contents (vector)
+ (is (equalp (coerce expected-contents 'vector)
+ (rb-contents rb :result-type 'vector)))
;; rb-count
(is (= (length expected-contents) (rb-count rb)))
;; rb-empty
@@ -55,7 +59,13 @@
(rb-safe-push rb 'c)
(is (= 4 (rb-size rb)))
(check-ring-buffer rb '(a b c))
- (signals error (rb-safe-push rb 'd))))
+ (signals error (rb-safe-push rb 'd))
+
+ (rb-clear rb)
+ (check-ring-buffer rb '())
+
+ (rb-clear rb)
+ (check-ring-buffer rb '())))
(define-test fuzz-ring-buffers
(do-range ((n 2 30))