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 ,@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 ,@os)) - (let ((tgt (gensym))) - `(,wrapper - (bif (,tgt ,tgt-form) - (if (trcp ,tgt) - (progn - (assert (stringp ,(car os))) - (call-trc t ,@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*))))