;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))

(in-package #:snow)

(defclass fifo ()
  ((buffer :initarg :buffer
           :initform ()
           :accessor buffer)
   (mutex :initarg :mutex
          :initform (sb-thread:make-mutex)
          :accessor mutex)
   (discard-preceding :initarg :discard-preceding
                      :initform nil
                      :accessor discard-preceding)
   (wait-interval :initarg :wait-interval
                  :initform 0
                  :accessor wait-interval)
   (timestamp :initarg :timestamp
              :initform (get-universal-time)
              :accessor timestamp))
  (:documentation ""))

(defmethod dequeue ((fifo fifo))
  (sb-thread:with-mutex ((mutex fifo))
    (when (or (= (wait-interval fifo) 0)
              (> (get-universal-time) (+ (timestamp fifo) (wait-interval fifo))))
      (setf (timestamp fifo) (get-universal-time))
      (when (buffer fifo)
        (pop (buffer fifo))))))

(defmethod enqueue ((fifo fifo) obj)
  (sb-thread:with-mutex ((mutex fifo))
    (if (discard-preceding fifo)
        (setf (buffer fifo) `(,obj))
        (push obj (buffer fifo)))))

(defmethod empty-p ((fifo fifo))
  (sb-thread:with-mutex ((mutex fifo))
    (endp (buffer fifo))))

(defmethod len ((fifo fifo))
  (sb-thread:with-mutex ((mutex fifo))
    (length (buffer fifo))))