[cells-gtk-cvs] CVS root/pod-utils

[pdenno]

Update of /project/cells-gtk/cvsroot/root/pod-utils
In directory clnet:/tmp/cvs-serv2395/root/pod-utils

Modified Files:
	utils.lisp 
Log Message:
Marco's patch http://common-lisp.net/pipermail/cells-gtk-devel/2006-May/000171.html and also moved trc routines to kt-trace.lisp

--- /project/cells-gtk/cvsroot/root/pod-utils/utils.lisp	2006/02/19 20:09:12	1.1
+++ /project/cells-gtk/cvsroot/root/pod-utils/utils.lisp	2006/06/01 14:24:40	1.2
@@ -469,7 +469,7 @@
     (format nil "~D.~2,'0D.~2,'0D  ~2,'0D:~2,'0D:~2,'0D" y month d h m s)))
 
 ;;; Norvig's search routines
-(defun tree-search (states goal-p successors combiner)
+(defun tree-search (states goal-p successors combiner &optional do-fn)
   "Find a state that satisfies GOAL-P. Start with STATES, 
    and search according to successors and combiners."
   (cond ((null states) :fail)
@@ -705,65 +705,3 @@
           (and (funcall fn x) (funcall chain x))))))
 
 
-;;; Kenny Tilton trace stuff ---------------
-
-(defparameter *trcdepth* 0)
-(defvar *count* nil)
-(defvar *counting* nil)
-(defvar *dbg*)
-(defvar *stop* nil)
-
-(defun utils-kt-reset ()
-  (setf *count* nil
-    *stop* nil
-    *dbg* nil
-    *trcdepth* 0))
-
-;----------- trc -------------------------------------------
-
-(defparameter *trcdepth* 0)
-(defvar *counting* nil)
-
-(defmacro count-it (&rest keys)
-  `(when *counting*
-     (call-count-it , at keys)))
-
-(defmacro trc (tgt-form &rest os
-                &aux (wrapper (if (macro-function 'without-c-dependency)
-                                  'without-c-dependency 'progn)))
-  (if (eql tgt-form 'nil)
-      '(progn)
-    (if (stringp tgt-form)
-        `(,wrapper
-          (call-trc t ,tgt-form , at os))
-      (let ((tgt (gensym)))
-        `(,wrapper
-          (bif (,tgt ,tgt-form)
-            (if (trcp ,tgt)
-                (progn
-                  (assert (stringp ,(car os)))
-                  (call-trc t , at os)) ;;,(car os) ,tgt ,@(cdr os)))
-              (progn
-                ;;(break "trcfailed")
-                (count-it :trcfailed)))
-            (count-it :tgtnileval)))))))
-
-(defun call-trc (stream s &rest os)
-  (if #+cormanlisp nil #-cormanlisp (and (boundp '*trcdepth*)
-          *trcdepth*)
-        (format stream "~&~v,,,'.<~d~>> " (mod *trcdepth* 100) *trcdepth*)
-      (format stream "~&"))
-    (format stream "~a" s)
-    (let (pkwp)
-      (dolist (o os)
-        (format stream (if pkwp " ~s" " | ~s") o)
-        (setf pkwp (keywordp o))))
-    (values))
-
-(defun call-count-it (&rest keys)
-    (declare (ignorable keys))
-  ;;; (when (eql :TGTNILEVAL (car keys))(break))
-  (let ((entry (assoc keys *count* :test #'equal)))
-      (if entry
-          (setf (cdr entry) (1+ (cdr entry)))
-        (push (cons keys 1) *count*))))