1 files changed, 64 insertions, 0 deletions
diff --git a/catbird/ring-buffer.scm b/catbird/ring-buffer.scm
new file mode 100644
index 0000000..ce265c0
--- /dev/null
+++ b/catbird/ring-buffer.scm
@@ -0,0 +1,64 @@
+(define-module (catbird ring-buffer)
+  #:use-module (srfi srfi-9)
+  #:export (make-ring-buffer
+            ring-buffer
+            ring-buffer-length
+            ring-buffer-put!
+            ring-buffer-get!
+            ring-buffer-ref
+            ring-buffer-clear!))
+
+(define-record-type <ring-buffer>
+  (%make-ring-buffer vector length head tail)
+  ring-buffer?
+  (vector ring-buffer-vector)
+  (length ring-buffer-length set-ring-buffer-length!)
+  (head ring-buffer-head set-ring-buffer-head!)
+  (tail ring-buffer-tail set-ring-buffer-tail!))
+
+(define (make-ring-buffer size)
+  (%make-ring-buffer (make-vector size #f) 0 0 0))
+
+(define (ring-buffer-empty? ring)
+  (zero? (ring-buffer-length ring)))
+
+(define (ring-buffer-put! ring x)
+  (let* ((head (ring-buffer-head ring))
+         (tail (ring-buffer-tail ring))
+         (l (ring-buffer-length ring))
+         (v (ring-buffer-vector ring))
+         (vl (vector-length v)))
+    (vector-set! v tail x)
+    (set-ring-buffer-length! ring (min (+ l 1) vl))
+    (when (and (> l 0) (= head tail))
+      (set-ring-buffer-head! ring (modulo (+ head 1) vl)))
+    (set-ring-buffer-tail! ring (modulo (+ tail 1) vl))))
+
+(define (ring-buffer-get! ring)
+  (if (ring-buffer-empty? ring)
+      (error "ring buffer empty" ring)
+      (let* ((head (ring-buffer-head ring))
+             (v (ring-buffer-vector ring))
+             (result (vector-ref v head)))
+        (vector-set! v head #f)
+        (set-ring-buffer-head! ring (modulo (+ head 1) (vector-length v)))
+        (set-ring-buffer-length! ring (- (ring-buffer-length ring) 1))
+        result)))
+
+(define (ring-buffer-ref ring i)
+  (let ((l (ring-buffer-length ring))
+        (v (ring-buffer-vector ring)))
+    (if (>= i l)
+        (error "ring buffer index out of bounds" i)
+        (vector-ref v (modulo (+ (ring-buffer-head ring) i)
+                              (vector-length v))))))
+
+(define (ring-buffer-clear! ring)
+  (let ((v (ring-buffer-vector ring)))
+    (set-ring-buffer-head! ring 0)
+    (set-ring-buffer-tail! ring 0)
+    (set-ring-buffer-length! ring 0)
+    (let loop ((i 0))
+      (when (< i (vector-length v))
+        (vector-set! v i #f)
+        (loop (+ i 1))))))