Add ring buffer implementation.

2 files changed, 82 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index cfd94c4..e77308b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -39,6 +39,7 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
 
 SOURCES = 					\
   starling/config.scm				\
+  starling/ring-buffer.scm			\
   starling/inotify.scm				\
   starling/system.scm				\
   starling/asset.scm				\
diff --git a/starling/ring-buffer.scm b/starling/ring-buffer.scm
new file mode 100644
index 0000000..2b67f78
--- /dev/null
+++ b/starling/ring-buffer.scm
@@ -0,0 +1,81 @@
+(define-module (starling 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))
+
+(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 (test)
+;;   (define (do-test ring)
+;;     (ring-buffer-put! ring 'h)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'e)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'l)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'l)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'o)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'w)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'o)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'r)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'l)
+;;     (pk ring)
+;;     (ring-buffer-put! ring 'd)
+;;     (pk ring)
+;;     (pk (ring-buffer-get! ring) (ring-buffer-get! ring) (ring-buffer-get! ring) (ring-buffer-get! ring))
+;;     (pk ring))
+;;   (let ((ring (make-ring-buffer 4)))
+;;     (do-test ring)
+;;     (do-test ring)))