[cells-cvs] CVS cells/utils-kt

[ktilton]

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

Modified Files:
	debug.lisp defpackage.lisp detritus.lisp flow-control.lisp 
	strings.lisp 
Log Message:
New :owning slot parameter automates NOT-TO-BE of slot contents as value/values disappear.

--- /project/cells/cvsroot/cells/utils-kt/debug.lisp	2006/09/03 13:41:10	1.11
+++ /project/cells/cvsroot/cells/utils-kt/debug.lisp	2006/09/05 18:40:48	1.12
@@ -95,20 +95,20 @@
   `(if ,onp
        (prog1
            (time (progn , at body))
-         (trc "timing was of" , at trcargs))
+         (format t "timing was of ~{ ~a~}" , at trcargs))
      (progn , at body)))
 
 #+save
 (defun dbg-time-report (cpu-gc-user cpu-gc-sys cpu-tot-user cpu-tot-sys real-time conses other-bytes static-bytes)
-  (trc "cpu-gc-user" cpu-gc-user)
-  (trc "cpu-gc-sys" cpu-gc-sys)
-  (trc "cpu-tot-user" cpu-tot-user)
-  (trc "cpu-tot-sys" cpu-tot-sys)
-  (trc "<non-gc user cpu>" (- cpu-tot-user cpu-gc-user))
-  (trc "<non-gc sys cpu>" (- cpu-tot-sys cpu-gc-sys))
-  (trc "conses" conses)
-  (trc "other-bytes" other-bytes)
-  (trc "static-bytes" static-bytes)
+  (format t "~&cpu-gc-user ~a" cpu-gc-user)
+  (format t "~&cpu-gc-sys ~a" cpu-gc-sys)
+  (format t "~&cpu-tot-user ~a" cpu-tot-user)
+  (format t "~&cpu-tot-sys ~a" cpu-tot-sys)
+  (format t "~&<non-gc user cpu> ~a" (- cpu-tot-user cpu-gc-user))
+  (format t "~&<non-gc sys cpu> ~a" (- cpu-tot-sys cpu-gc-sys))
+  (format t "~&conses ~a" conses)
+  (format t "~&other-bytes ~a" other-bytes)
+  (format t "~&static-bytes ~a" static-bytes)
   (excl::time-report cpu-gc-user cpu-gc-sys cpu-tot-user cpu-tot-sys real-time conses other-bytes static-bytes))
 
 ;---------------- Metrics -------------------
--- /project/cells/cvsroot/cells/utils-kt/defpackage.lisp	2006/08/21 04:29:31	1.5
+++ /project/cells/cvsroot/cells/utils-kt/defpackage.lisp	2006/09/05 18:40:48	1.6
@@ -26,13 +26,13 @@
     #+openmcl-partial-mop #:openmcl-mop
     #+(and mcl (not openmcl-partial-mop))  #:ccl)
   (:export #:utils-kt-reset
-    #:eko #:count-it #:count-of #:trc #:trcp 
+     #:count-it #:count-of
     #:wdbg #:maptimes #:bwhen #:bif #:xor
     #:with-dynamic-fn #:last1 #:packed-flat! #:with-metrics 
     #:shortc
     #:intern$
     #:define-constant #:*count* #:*stop*
-    #:*dbg* #:*trcdepth*
+    #:*dbg*
     #:make-fifo-queue #:fifo-queue #:fifo-add #:fifo-delete
     #:fifo-empty #:fifo-pop #:fifo-clear
     #:fifo-map #:fifo-peek #:fifo-data #:with-fifo-map #:fifo-length
--- /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2006/08/21 04:29:31	1.9
+++ /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2006/09/05 18:40:48	1.10
@@ -154,8 +154,7 @@
 (defun tree-includes (sought tree &key (test 'eql))
   (typecase tree
     (null)
-    (atom (eko (nil "tree-inc? testing" sought tree)
-            (funcall test sought tree)))
+    (atom (funcall test sought tree))
     (cons (loop for subtree in tree
                 when (tree-includes sought subtree :test test)
                 do (return-from tree-includes t)))))
@@ -171,7 +170,6 @@
 (defun tree-intersect (t1 t2 &key (test 'eql))
   (tree-traverse t1
     (lambda (t1-node)
-      (eko (nil "treeinter?" t1-node t2)
-        (when (tree-includes t1-node t2 :test test)
-          (return-from tree-intersect t1-node))))))
+      (when (tree-includes t1-node t2 :test test)
+          (return-from tree-intersect t1-node)))))
 
--- /project/cells/cvsroot/cells/utils-kt/flow-control.lisp	2006/08/21 04:29:31	1.5
+++ /project/cells/cvsroot/cells/utils-kt/flow-control.lisp	2006/09/05 18:40:50	1.6
@@ -31,7 +31,7 @@
 (defun min-if (v1 v2)
      (if v1 (if v2 (min v1 v2) v1) v2))
 
-(export! list-flatten!)
+(export! list-flatten! tree-flatten)
 
 (defun list-flatten! (&rest list)
   (if (consp list)
@@ -56,6 +56,9 @@
       head)
     list))
 
+(defun tree-flatten (tree)
+  (list-flatten! (copy-tree tree)))
+
 (defun packed-flat! (&rest u-nameit)
    (delete nil (list-flatten! u-nameit)))
 
--- /project/cells/cvsroot/cells/utils-kt/strings.lisp	2006/07/06 22:10:03	1.5
+++ /project/cells/cvsroot/cells/utils-kt/strings.lisp	2006/09/05 18:40:50	1.6
@@ -140,8 +140,7 @@
    (or (null s)
        (if (stringp s)
           (string-equal "" (trim$ s))
-          #+(or) (trc nil "empty$> sees non-string" (type-of s)))
-       ))
+          #+(or) (format t "empty$> sees non-string ~a" (type-of s)))))
 
 (defmacro find$ (it where &rest args)
   `(find ,it ,where , at args :test #'string-equal))