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 ,@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)