Revision: 3593 Author: ksprotte URL: http://bknr.net/trac/changeset/3593
moved simple queue to bos.m2 U trunk/projects/bos/m2/allocation.lisp U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/m2/utils.lisp U trunk/projects/bos/web/quad-tree.lisp
Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-23 16:19:59 UTC (rev 3592) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-23 17:53:36 UTC (rev 3593) @@ -299,13 +299,13 @@ (unless (funcall pred start-x start-y) (error "sqm ~A/~A not allocatable" start-x start-y)) (let* ((allocated (make-hash-table :test #'equal)) - (border-queue (bos.web::make-queue)) + (border-queue (make-queue)) connected) (labels - ((enqueue (x y) + ((enqueue* (x y) (let ((key (list x y))) (setf (gethash key allocated) t) - (bos.web::enqueue key border-queue))) + (enqueue key border-queue))) (try-get (&rest key) (and (not (gethash key allocated)) (apply pred key) @@ -315,20 +315,20 @@ (try-get x (1+ y)) (try-get (1- x) y) (try-get x (1- y))))) - (enqueue start-x start-y) + (enqueue* start-x start-y) (dotimes (i (1- n) - (append connected (bos.web::queue-elements border-queue))) + (append connected (queue-elements border-queue))) (tagbody retry - (destructuring-bind (x y) (bos.web::peek-queue border-queue) + (destructuring-bind (x y) (peek-queue border-queue) (let ((next (get-next-neighbor x y))) (cond (next - (apply #'enqueue next)) - ((bos.web::queue-empty-p border-queue) + (apply #'enqueue* next)) + ((queue-empty-p border-queue) (return nil)) (t - (push (bos.web::dequeue border-queue) connected) + (push (dequeue border-queue) connected) (go retry))))))))))
(defun allocate-in-area (area n)
Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-07-23 16:19:59 UTC (rev 3592) +++ trunk/projects/bos/m2/packages.lisp 2008-07-23 17:53:36 UTC (rev 3593) @@ -260,6 +260,13 @@ #:mail-print-pdf
#:*cert-download-directory* + + #:make-queue + #:queue-empty-p + #:enqueue + #:dequeue + #:queue-elements + #:peek-queue ))
(defpackage :bos.m2.cert-generator
Modified: trunk/projects/bos/m2/utils.lisp =================================================================== --- trunk/projects/bos/m2/utils.lisp 2008-07-23 16:19:59 UTC (rev 3592) +++ trunk/projects/bos/m2/utils.lisp 2008-07-23 17:53:36 UTC (rev 3593) @@ -54,4 +54,28 @@ (t (let ((obj (funcall tie-breaker free-objs result))) (setf free-objs (remove obj free-objs)) - (next-result obj)))))))) \ No newline at end of file + (next-result obj)))))))) + +;;; simple queue +(defun make-queue () + (cons nil nil)) + +(defun queue-empty-p (queue) + (null (car queue))) + +(defun enqueue (x queue) + (if (null (car queue)) + (setf (cdr queue) (setf (car queue) (list x))) + (setf (cdr (cdr queue)) (list x) + (cdr queue) (cdr (cdr queue)))) + (caar queue)) + +(defun dequeue (queue) + (pop (car queue))) + +(defun queue-elements (queue) + (car queue)) + +(defun peek-queue (queue) + (caar queue)) +
Modified: trunk/projects/bos/web/quad-tree.lisp =================================================================== --- trunk/projects/bos/web/quad-tree.lisp 2008-07-23 16:19:59 UTC (rev 3592) +++ trunk/projects/bos/web/quad-tree.lisp 2008-07-23 17:53:36 UTC (rev 3593) @@ -118,29 +118,6 @@ (defvar *m2-geo-box* (make-geo-box 116.92538417241805d0 -0.9942953097298868d0 117.02245623511905d0 -1.0920067364569994d0))
-;;; simple queue -(defun make-queue () - (cons nil nil)) - -(defun queue-empty-p (queue) - (null (car queue))) - -(defun enqueue (x queue) - (if (null (car queue)) - (setf (cdr queue) (setf (car queue) (list x))) - (setf (cdr (cdr queue)) (list x) - (cdr queue) (cdr (cdr queue)))) - (caar queue)) - -(defun dequeue (queue) - (pop (car queue))) - -(defun queue-elements (queue) - (car queue)) - -(defun peek-queue (queue) - (caar queue)) - ;;; quad-node (defclass quad-node () ((geo-box :reader geo-box :initarg :geo-box :type geo-box)