[bknr-cvs] r2362 - branches/bos/projects/bos/m2

[ksprotte at common-lisp.net]

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