37 lines
1.4 KiB
Common Lisp
37 lines
1.4 KiB
Common Lisp
;;; Obtained from Usenet,
|
|
;;; Message-ID: <b3b1cc90-2e2b-43c3-b7d9-785ae29870e7@e23g2000prf.googlegroups.com>
|
|
;;; Posting by Kaz Kylheku, February 28, 2008.
|
|
|
|
(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)))
|