Author: ksprotte Date: Fri Jan 18 13:50:57 2008 New Revision: 2362 Modified: branches/bos/projects/bos/m2/allocation-cache.lisp branches/bos/projects/bos/m2/bos.m2.asd branches/bos/projects/bos/m2/packages.lisp Log: using awhen from arnesi for allocation cache Modified: branches/bos/projects/bos/m2/allocation-cache.lisp ============================================================================== --- branches/bos/projects/bos/m2/allocation-cache.lisp (original) +++ branches/bos/projects/bos/m2/allocation-cache.lisp Fri Jan 18 13:50:57 2008 @@ -78,7 +78,7 @@ (setf (aref array next-x next-y) nil)) (do-neighbour-coordinates next-x next-y (x y) (when (and (in-array-bounds-p array x y) - (free-spot-p array x y)) + (free-spot-p array x y)) (collect (aref array x y)) (setf (aref array x y) nil) (point-stack-push x y stack))))) @@ -148,15 +148,12 @@ is decremented." (cond ((not (size-indexed-p n)) nil) - (remove (let ((cache-entry (index-pop n))) - (when cache-entry - (with-slots (area region) - cache-entry - (decf (allocation-area-free-m2s area) n) - region)))) - (t (let ((cache-entry (index-lookup n))) - (when cache-entry - (cache-entry-region cache-entry)))))) + (remove (awhen (index-pop n) + (with-slots (area region) it + (decf (allocation-area-free-m2s area) n) + region))) + (t (awhen (index-lookup n) + (cache-entry-region it))))) (defun add-area (allocation-area) (dolist (region (free-regions allocation-area) @@ -176,7 +173,7 @@ (iter (for regions in-vector (allocation-cache-index *allocation-cache*)) (for size upfrom 1) - (for region-count = (length regions)) + (for region-count = (length regions)) (unless (zerop region-count) (format t "~a~10T~a~%" size region-count))) (format t "area size ignored by cache: ~a~%" (ignored-size *allocation-cache*))) @@ -191,7 +188,7 @@ (iter (for regions in-vector (allocation-cache-index *allocation-cache*)) (for size upfrom 1) - (for region-count = (length regions)) + (for region-count = (length regions)) (unless (zerop region-count) (leave size)))) @@ -199,7 +196,7 @@ (defclass allocation-cache-subsystem () ()) -(defmethod bknr.datastore::restore-subsystem (store (subsystem allocation-cache-subsystem) &key until) +(defmethod bknr.datastore::restore-subsystem + (store (subsystem allocation-cache-subsystem) &key until) (declare (ignore until)) (rebuild-cache)) - Modified: branches/bos/projects/bos/m2/bos.m2.asd ============================================================================== --- branches/bos/projects/bos/m2/bos.m2.asd (original) +++ branches/bos/projects/bos/m2/bos.m2.asd Fri Jan 18 13:50:57 2008 @@ -1,7 +1,7 @@ (in-package :cl-user) (asdf:defsystem :bos.m2 - :depends-on (:bknr :bknr-modules :net.post-office :cl-mime :iconv :kmrcl :iterate) + :depends-on (:bknr :bknr-modules :net.post-office :cl-mime :iconv :kmrcl :iterate :arnesi) :components ((:file "packages") (:file "config" :depends-on ("packages")) (:file "utils" :depends-on ("config")) Modified: branches/bos/projects/bos/m2/packages.lisp ============================================================================== --- branches/bos/projects/bos/m2/packages.lisp (original) +++ branches/bos/projects/bos/m2/packages.lisp Fri Jan 18 13:50:57 2008 @@ -216,12 +216,10 @@ (intern "POINT-IN-POLYGON-P" :bos.m2) (defpackage :bos.m2.allocation-cache - (:use :cl - :bknr.utils + (:use :cl :bknr.indices :bknr.datastore - :bknr.user - :bknr.web + :bknr.user :bknr.images :bknr.statistics :bknr.rss