[cells-cvs] CVS cells/utils-kt

[ktilton]

Update of /project/cells/cvsroot/cells/utils-kt
In directory clnet:/tmp/cvs-serv21938/utils-kt

Modified Files:
	debug.lisp detritus.lisp flow-control.lisp 
Log Message:


--- /project/cells/cvsroot/cells/utils-kt/debug.lisp	2007/12/03 12:21:01	1.16
+++ /project/cells/cvsroot/cells/utils-kt/debug.lisp	2008/01/29 04:29:55	1.17
@@ -61,7 +61,8 @@
 
 (defun call-count-it (&rest keys)
     (declare (ignorable keys))
-  ;;; (when (eql :TGTNILEVAL (car keys))(break))
+  (when (find (car keys) '(:trcfailed :TGTNILEVAL))
+    (break "clean up time ~a" keys))
   (let ((entry (assoc keys *count* :test #'equal)))
       (if entry
           (setf (cdr entry) (1+ (cdr entry)))
--- /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2007/12/03 20:11:12	1.16
+++ /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2008/01/29 04:29:55	1.17
@@ -59,24 +59,28 @@
 (defun collect-if (test list)
   (remove-if-not test list))
 
-#-iamnotkenny
-(defun test-setup ()
-  #-its-alive!
+(defun test-setup (&optional drib)
+  #-(or iamnotkenny its-alive!)
   (ide.base::find-new-prompt-command
-   (cg.base::find-window :listener-frame)))
+   (cg.base::find-window :listener-frame))
+  (when drib
+    (dribble (merge-pathnames 
+              (make-pathname :name drib :type "TXT")
+              (project-path)))))
+
+(export! project-path)
+(defun project-path ()
+  (excl:path-pathname (ide.base::project-file ide.base:*current-project*)))
 
 #+test
 (test-setup)
 
-#-iamnotkenny
-(defun test-prep ()
-  (test-setup))
-
-#-iamnotkenny
-(defun test-init ()
-  (test-setup))
+(defun test-prep (&optional drib)
+  (test-setup drib))
+
+(defun test-init (&optional drib)
+  (test-setup drib))
 
-#-iamnotkenny
 (export! test-setup test-prep test-init)
 
 ;;; --- FIFO Queue -----------------------------
--- /project/cells/cvsroot/cells/utils-kt/flow-control.lisp	2007/11/30 16:51:20	1.11
+++ /project/cells/cvsroot/cells/utils-kt/flow-control.lisp	2008/01/29 04:29:55	1.12
@@ -124,6 +124,27 @@
   `(loop for ,nvar below ,count
        collecting (progn , at body)))
 
+(export! maphash* hashtable-assoc -1?1 -1?1 prime?)
+
+(defun maphash* (f h)
+  (loop for k being the hash-keys of h
+        using (hash-value v)
+        collecting (funcall f k v)))
+
+(defun hashtable-assoc (h)
+  (maphash* (lambda (k v) (cons k v)) h))
+
+(define-symbol-macro -1?1 (expt -1 (random 2)))
+
+(defun -1?1 (x) (* -1?1 x))
+
+(defun prime? (n)
+  (and (> n 1)
+    (or (= 2 n)(oddp n))
+    (loop for d upfrom 3 by 2 to (sqrt n)
+        when (zerop (mod n d)) return nil
+        finally (return t))))
+
 ; --- cloucell support for struct access of slots ------------------------
 
 (eval-when (:compile-toplevel :execute :load-toplevel)