-
-
Notifications
You must be signed in to change notification settings - Fork 46
/
list-container.lisp
75 lines (66 loc) · 2.98 KB
/
list-container.lisp
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
(in-package #:org.shirakumo.fraf.trial)
(defclass list-container (container)
((%objects :initform () :accessor %objects)))
(defmethod clear ((container list-container))
(let ((objects (%objects container)))
(loop while objects
do (setf (container (pop objects)) NIL))
(setf (%objects container) objects))
container)
(defmethod enter (thing (container list-container))
(push thing (%objects container))
thing)
(defmethod leave (thing (container list-container))
(setf (%objects container) (delete thing (%objects container)))
thing)
(defmethod finalize ((container list-container))
(for:for ((object in (%objects container)))
(finalize object)))
(defmethod sequences:elt ((container list-container) index)
(nth index (%objects container)))
(defmethod (setf sequences:elt) (thing (container list-container) index)
(setf (nth index (%objects container)) thing))
(defmethod sequences:make-sequence-iterator ((container list-container) &key (start 0) end from-end)
(let ((list (%objects container)))
(multiple-value-bind (iterator limit from-end)
(if from-end
(let* ((termination (if (= start 0) #1='(NIL . NIL) (nthcdr (1- start) list)))
(init (if (<= (or end (length list)) start)
termination
(if end (last list (- (length list) (1- end))) (last list)))))
(values init termination t))
(cond
((not end) (values (nthcdr start list) nil nil))
(t (let ((st (nthcdr start list)))
(values st (nthcdr (- end start) st) nil)))))
(values iterator limit from-end
(if from-end
(lambda (sequence iterator from-end)
(declare (ignore sequence from-end))
(if (eq iterator list)
#1#
(do* ((cdr list (cdr cdr)))
((eq (cdr cdr) iterator) cdr))))
(lambda (sequence iterator from-end)
(declare (ignore sequence from-end))
(cdr iterator)))
(lambda (sequence iterator limit from-end)
(declare (ignore sequence from-end))
(eq iterator limit))
(lambda (sequence iterator)
(declare (ignore sequence))
(car iterator))
(lambda (new-value sequence iterator)
(declare (ignore sequence))
(setf (car iterator) new-value))
(lambda (sequence iterator)
(declare (ignore sequence))
(loop for cdr on list
for i from 0
when (eq cdr iterator)
return i))
(lambda (sequence iterator)
(declare (ignore sequence))
iterator)))))
(defmethod for:make-iterator ((container list-container) &rest args)
(apply #'for:make-iterator (%objects container) args))