~mdw
/
lisp
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
6d23b6b
)
queue: Allow stuff to be pushed on the front.
author
Mark Wooding
<mdw@distorted.org.uk>
Mon, 16 Jun 2008 22:27:32 +0000
(23:27 +0100)
committer
Mark Wooding
<mdw@distorted.org.uk>
Mon, 16 Jun 2008 22:27:32 +0000
(23:27 +0100)
queue.lisp
patch
|
blob
|
blame
|
history
diff --git
a/queue.lisp
b/queue.lisp
index
03de433
..
49c69c5
100644
(file)
--- a/
queue.lisp
+++ b/
queue.lisp
@@
-23,7
+23,7
@@
(defpackage #:queue
(:use #:common-lisp)
(defpackage #:queue
(:use #:common-lisp)
- (:export #:make-queue #:queue-emptyp #:enqueue #:dequeue))
+ (:export #:make-queue #:queue-emptyp #:enqueue #:
pushqueue #:
dequeue))
(in-package #:queue)
(defun make-queue ()
(in-package #:queue)
(defun make-queue ()
@@
-45,6
+45,13
@@
(setf (cdr (car q)) c
(car q) c)))
(setf (cdr (car q)) c
(car q) c)))
+(defun pushqueue (x q)
+ "Push the object X onto the front of the queue Q."
+ (let* ((first (cdr q))
+ (new (cons x first)))
+ (setf (cdr q) new)
+ (unless first (setf (car q) new))))
+
(defun dequeue (q)
"Remove and return the object at the head of the queue Q."
(if (queue-emptyp q)
(defun dequeue (q)
"Remove and return the object at the head of the queue Q."
(if (queue-emptyp q)
@@
-74,10
+81,12
@@
(let ((q (make-queue))
(want nil))
(dotimes (i 10000)
(let ((q (make-queue))
(want nil))
(dotimes (i 10000)
- (case (random
2
)
+ (case (random
3
)
(0 (setf want (nconc want (list i)))
(enqueue i q))
(0 (setf want (nconc want (list i)))
(enqueue i q))
- (1 (if (null want)
+ (1 (push i want)
+ (pushqueue i q))
+ (2 (if (null want)
(assert (queue-emptyp q))
(progn
(let ((j (dequeue q))
(assert (queue-emptyp q))
(progn
(let ((j (dequeue q))