blob: 7fca7e1f63649fe6917b4bbd4fa37b4c30c85e50 (
plain)
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
|
;;;
;;; deque data type for Lisp
;;;
;;; Copyright 2012 Kaz Kylheku <kaz@kylheku.com>
;;;
;;; With the help of the pop-deque macro below, you can represent
;;; a deque using two Lisp lists. Use one list for the
;;; front end of the deque and another list for the back.
;;; Let's call these F and B.
;;;
;;; Then, to pop from the front use (pop-deque F B).
;;; To pop from the back, reverse the list arguments: (pop-deque B F).
;;; The macro moves items from one to the other if there
;;; is an underflow.
;;;
;;; Pushing into the deque is done using regular Lisp push
;;; operations: (push item F) or (push item B).
;;;
;;; (or F B) gives us a test whether the dequeue is not empty.
;;;
;;; (+ (length F) (length B)) gives us the length.
;;;
;;;
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun bisect-list (list &optional (minimum-length 0))
(do ((double-skipper (cddr list) (cddr double-skipper))
(single-skipper list (cdr single-skipper))
(length 2 (+ length (if (cdr double-skipper) 2 1))))
((null double-skipper)
(cond
((< length minimum-length)
(values list nil))
((consp single-skipper)
(multiple-value-prog1
(values list (cdr single-skipper))
(setf (cdr single-skipper) nil)))
(t (values list nil))))))
(defun pop-deque-helper (facing-piece other-piece)
(if (null facing-piece)
(multiple-value-bind (head tail) (bisect-list other-piece 10)
(let ((remaining (if tail head))
(moved (nreverse (or tail head))))
(values (first moved) (rest moved) remaining)))
(values (first facing-piece) (rest facing-piece) other-piece))))
(defmacro pop-deque (facing-piece other-piece)
(let ((result (gensym))
(new-facing (gensym))
(new-other (gensym)))
`(multiple-value-bind (,result ,new-facing ,new-other)
(pop-deque-helper ,facing-piece ,other-piece)
(psetf ,facing-piece ,new-facing
,other-piece ,new-other)
,result)))
|
