(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))))))