1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
(in-package #:containers)
;;; Ring Buffers
;;;
;;; Code adapted from ANSI Common Lisp by Paul Graham (chapter 7)
;;;
;;; A ring buffer is a bounded queue. It supports:
;;; item-at (setf item-at)
;;; insert-item, dequeue, empty!, empty-p, size, total-size, first-element
(defclass* ring-buffer (abstract-queue
bounded-container-mixin
iteratable-container-mixin
concrete-container)
((contents :initarg :contents
:reader contents)
(buffer-start :initform 0
:reader buffer-start)
(buffer-end :initform 0
:reader buffer-end)
(total-size :initarg :total-size
:reader total-size)))
(defun make-ring-buffer (size)
(make-instance 'ring-buffer
:contents (make-array size)
:total-size size))
(defmethod make-container ((class (eql 'ring-buffer)) &rest args)
(let ((total-size (getf args :total-size 1)))
(remf args :total-size)
(make-ring-buffer total-size)))
;;?? the (first indexes) is odd...
(defmethod item-at ((container ring-buffer) &rest indexes)
(declare (dynamic-extent indexes))
(svref (contents container)
(mod (first indexes) (total-size container))))
(defmethod item-at! ((container ring-buffer) value &rest indexes)
(declare (dynamic-extent indexes))
(setf (svref (contents container)
(mod (first indexes) (total-size container)))
value))
(defmethod increment-end ((container ring-buffer))
(with-slots (buffer-end buffer-start) container
(when (and (>= buffer-end (total-size container))
(= (mod buffer-end (total-size container)) buffer-start))
(incf buffer-start))
(incf buffer-end)))
(defmethod next-item ((container ring-buffer))
(increment-end container)
(current-item container))
(defmethod current-item ((container ring-buffer))
(item-at container (buffer-end container)))
(defmethod insert-item ((container ring-buffer) item)
(prog1
(setf (item-at container (buffer-end container)) item)
(increment-end container)))
(defmethod delete-first ((container ring-buffer))
(with-slots (buffer-start) container
(prog1
(item-at container buffer-start)
(incf buffer-start))))
(defmethod empty! ((container ring-buffer))
(with-slots (buffer-end buffer-start)
container
(setf buffer-start 0
buffer-end 0))
(values))
#+Ignore
(defmethod total-size ((container ring-buffer))
(total-size container))
(defmethod size ((container ring-buffer))
(- (buffer-end container) (buffer-start container)))
(defmethod first-element ((container ring-buffer))
(item-at container (buffer-start container)))
(defmethod (setf first-element) (value (container ring-buffer))
(setf (item-at container (buffer-start container)) value))
(defmethod iterate-nodes ((container ring-buffer) fn)
(loop for index from (buffer-start container) to (1- (buffer-end container)) do
(funcall fn (item-at container index))))
#+No
;; screws with the buffer pointers
(defmethod iterate-nodes ((container ring-buffer) fn)
(loop repeat (total-size container)
with item = (current-item container) do
(funcall fn item)
(setf item (next-item container))))
|
