#lang racket/base
(struct %rackonsole:ringbuf
((vec)
(size)
(start #:mutable)
(used #:mutable))
#:transparent
#:property prop:sequence
(lambda (rb)
(let ((used (%rackonsole:ringbuf-used rb)))
(if (zero? used)
(make-do-sequence
(lambda ()
(values
void
(lambda (pos) #f)
#f
(lambda (pos) #f)
#f
#f)))
(let ((vec (%rackonsole:ringbuf-vec rb))
(start (%rackonsole:ringbuf-start rb)))
(if (= 1 used)
(make-do-sequence
(lambda ()
(values
(lambda (pos) (vector-ref vec pos))
(lambda (pos) #f)
start
(lambda (pos) pos)
#f
#f)))
(let* ((size (%rackonsole:ringbuf-size rb))
(last-vector-pos (- size 1))
(last-sequence-pos (modulo (+ start used -1)
size)))
(make-do-sequence
(lambda ()
(values
(lambda (pos) (vector-ref vec pos))
(lambda (pos)
(cond ((= pos last-sequence-pos) #f)
((= pos last-vector-pos) 0)
(else (+ 1 pos))))
start
(lambda (pos) pos)
#f
#f))))))))))
(provide %rackonsole:ringbuf/size)
(define (%rackonsole:ringbuf/size size)
(let ((size (inexact->exact size)))
(%rackonsole:ringbuf (make-vector size)
size
0
0)))
(provide %rackonsole:ringbuf/size/start)
(define (%rackonsole:ringbuf/size/start size start)
(let ((size (inexact->exact size)))
(%rackonsole:ringbuf (make-vector size)
size
start
0)))
(provide %rackonsole:ringbuf-size+pos->next-pos)
(define (%rackonsole:ringbuf-size+pos->next-pos size pos)
(if (= pos (- size 1))
0
(+ 1 pos)))
(provide %rackonsole:ringbuf-append!)
(define (%rackonsole:ringbuf-append! rb v)
(let ((size (%rackonsole:ringbuf-size rb)))
(if (zero? size)
(error '%rackonsole:ringbuf-append!
"cannot append to %rackonsole:ringbuf size 0")
(let ((vec (%rackonsole:ringbuf-vec rb))
(start (%rackonsole:ringbuf-start rb))
(used (%rackonsole:ringbuf-used rb)))
(if (= used size)
(begin (vector-set! vec start v)
(set-%rackonsole:ringbuf-start! rb (%rackonsole:ringbuf-size+pos->next-pos size start)))
(begin (vector-set! vec
(modulo (+ start used) size)
v)
(set-%rackonsole:ringbuf-used! rb (+ 1 used))))))))
(provide %rackonsole:ringbuf-size+pos->prev-pos)
(define (%rackonsole:ringbuf-size+pos->prev-pos size pos)
(if (zero? pos)
(- size 1)
(- pos 1)))
(provide %rackonsole:ringbuf-prepend!)
(define (%rackonsole:ringbuf-prepend! rb v)
(let ((size (%rackonsole:ringbuf-size rb)))
(if (zero? size)
(error '%rackonsole:ringbuf-prepend!
"cannot prepend to %rackonsole:ringbuf size 0")
(let ((used (%rackonsole:ringbuf-used rb))
(new-start (%rackonsole:ringbuf-size+pos->prev-pos size (%rackonsole:ringbuf-start rb))))
(vector-set! (%rackonsole:ringbuf-vec rb) new-start v)
(set-%rackonsole:ringbuf-start! rb new-start)
(or (= used size)
(set-%rackonsole:ringbuf-used! rb (+ 1 used)))))))