Changeset 3593

Show
Ignore:
Timestamp:
07/23/08 19:53:36 (4 months ago)
Author:
ksprotte
Message:

moved simple queue to bos.m2

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/m2/allocation.lisp

    r3588 r3593  
    300300    (error "sqm ~A/~A not allocatable" start-x start-y)) 
    301301  (let* ((allocated (make-hash-table :test #'equal)) 
    302          (border-queue (bos.web::make-queue)) 
     302         (border-queue (make-queue)) 
    303303         connected) 
    304304    (labels 
    305         ((enqueue (x y) 
     305        ((enqueue* (x y) 
    306306           (let ((key (list x y))) 
    307307             (setf (gethash key allocated) t) 
    308              (bos.web::enqueue key border-queue))) 
     308             (enqueue key border-queue))) 
    309309         (try-get (&rest key)            
    310310           (and (not (gethash key allocated)) 
    …… 
    316316               (try-get (1- x) y) 
    317317               (try-get x (1- y))))) 
    318       (enqueue start-x start-y) 
     318      (enqueue* start-x start-y) 
    319319      (dotimes (i (1- n) 
    320                 (append connected (bos.web::queue-elements border-queue))) 
     320                (append connected (queue-elements border-queue))) 
    321321        (tagbody 
    322322         retry 
    323            (destructuring-bind (x y) (bos.web::peek-queue border-queue) 
     323           (destructuring-bind (x y) (peek-queue border-queue) 
    324324             (let ((next (get-next-neighbor x y))) 
    325325               (cond 
    326326                 (next 
    327                   (apply #'enqueue next)) 
    328                  ((bos.web::queue-empty-p border-queue) 
     327                  (apply #'enqueue* next)) 
     328                 ((queue-empty-p border-queue) 
    329329                  (return nil)) 
    330330                 (t 
    331                   (push (bos.web::dequeue border-queue) connected) 
     331                  (push (dequeue border-queue) connected) 
    332332                  (go retry)))))))))) 
    333333 

  • trunk/projects/bos/m2/packages.lisp

    r3554 r3593  
    261261 
    262262           #:*cert-download-directory* 
     263 
     264           #:make-queue 
     265           #:queue-empty-p 
     266           #:enqueue 
     267           #:dequeue 
     268           #:queue-elements 
     269           #:peek-queue            
    263270           )) 
    264271 

  • trunk/projects/bos/m2/utils.lisp

    r3166 r3593  
    5656                  (setf free-objs (remove obj free-objs)) 
    5757                  (next-result obj)))))))) 
     58 
     59;;; simple queue 
     60(defun make-queue () 
     61  (cons nil nil)) 
     62 
     63(defun queue-empty-p (queue) 
     64  (null (car queue))) 
     65 
     66(defun enqueue (x queue) 
     67  (if (null (car queue)) 
     68      (setf (cdr queue) (setf (car queue) (list x))) 
     69    (setf (cdr (cdr queue)) (list x) 
     70          (cdr queue) (cdr (cdr queue)))) 
     71  (caar queue)) 
     72 
     73(defun dequeue (queue) 
     74  (pop (car queue))) 
     75 
     76(defun queue-elements (queue) 
     77  (car queue)) 
     78 
     79(defun peek-queue (queue) 
     80  (caar queue)) 
     81 

  • trunk/projects/bos/web/quad-tree.lisp

    r3588 r3593  
    119119                                   117.02245623511905d0 -1.0920067364569994d0)) 
    120120 
    121 ;;; simple queue 
    122 (defun make-queue () 
    123   (cons nil nil)) 
    124  
    125 (defun queue-empty-p (queue) 
    126   (null (car queue))) 
    127  
    128 (defun enqueue (x queue) 
    129   (if (null (car queue)) 
    130       (setf (cdr queue) (setf (car queue) (list x))) 
    131     (setf (cdr (cdr queue)) (list x) 
    132           (cdr queue) (cdr (cdr queue)))) 
    133   (caar queue)) 
    134  
    135 (defun dequeue (queue) 
    136   (pop (car queue))) 
    137  
    138 (defun queue-elements (queue) 
    139   (car queue)) 
    140  
    141 (defun peek-queue (queue) 
    142   (caar queue)) 
    143  
    144121;;; quad-node 
    145122(defclass quad-node ()