Adding deque that I posted to Usenet some years ago.

1 files changed, 56 insertions, 0 deletions

diff --git a/deque.lisp b/deque.lisp
new file mode 100644
index 0000000..112e224
--- /dev/null
+++ b/deque.lisp
@@ -0,0 +1,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)))