From dd33a77309be7d492ef49bfdacbc131abe1ddced Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Mon, 16 Jun 2008 23:27:32 +0100 Subject: [PATCH] queue: Allow stuff to be pushed on the front. --- queue.lisp | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) 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)) -- 2.11.0