#lang racket/base
;; For legal info, see file "info.rkt".

;; TODO: Maybe make this a ringbuf package.

(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
                                        ; pos->element
              void
                                        ; pos->next-pos
              (lambda (pos) #f)
                                        ; initial-pos
              #f
                                        ; pos->continue?
              (lambda (pos) #f)
              #f
              #f)))
          (let ((vec   (%rackonsole:ringbuf-vec   rb))
                (start (%rackonsole:ringbuf-start rb)))
            (if (= 1 used)
                (make-do-sequence
                 (lambda ()
                   (values
                                        ; pos->element
                    (lambda (pos) (vector-ref vec pos))
                                        ; pos->next-pos
                    (lambda (pos) #f)
                                        ; initial-pos
                    start
                                        ; pos->continue?
                    (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
                                        ; pos->element
                      (lambda (pos) (vector-ref vec pos))
                                        ; pos->next-pos
                      (lambda (pos)
                        (cond ((= pos last-sequence-pos) #f)
                              ((= pos last-vector-pos)   0)
                              (else (+ 1 pos))))
                                        ; initial-pos
                      start
                                        ; pos->continue?
                      (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)
  ;; TODO: This is for testing only.
  (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)))))))