X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/2626af6648d844d428b3da1c12d1401e42405593..0eed4749891adf0a7be89e786b8968ee805a8d41:/queue.lisp

diff --git a/queue.lisp b/queue.lisp
index 03de433..49c69c5 100644
--- a/queue.lisp
+++ b/queue.lisp
@@ -23,7 +23,7 @@
 
 (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 ()
@@ -45,6 +45,13 @@
     (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)
@@ -74,10 +81,12 @@
   (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))
-	(1 (if (null want)
+	(1 (push i want)
+	   (pushqueue i q))
+	(2 (if (null want)
 	       (assert (queue-emptyp q))
 	       (progn
 		 (let ((j (dequeue q))