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 ,@body)) - (trc "timing was of" ,@trcargs)) + (format t "timing was of ~{ ~a~}" ,@trcargs)) (progn ,@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 ,@args :test #'string-equal))