diff --git a/shop3/io/debugging.lisp b/shop3/io/debugging.lisp index 216447c0..9681f792 100644 --- a/shop3/io/debugging.lisp +++ b/shop3/io/debugging.lisp @@ -75,7 +75,7 @@ (defconstant +shop-trace-items+ (list :methods :axioms :operators :tasks :goals :effects :protections - :states :plans :item) + :states :plans :item :loop) "Acceptable arguments for SHOP-TRACE (and SHOP-UNTRACE).") (defmacro shop-trace (&rest items) diff --git a/shop3/looping-tasks/conditional-extensions.lisp b/shop3/looping-tasks/conditional-extensions.lisp index bfb8ef06..e7a7a028 100644 --- a/shop3/looping-tasks/conditional-extensions.lisp +++ b/shop3/looping-tasks/conditional-extensions.lisp @@ -37,19 +37,19 @@ (defmethod expand-conditional-task ((domain looping-domain) ess-search-state) - (dbg-lp "~%Expanding the conditional now...") + (trace-print :loop domain ess-search-state "~%Expanding the conditional now...") (with-slots (top-tasks tasks current-task unifier backtrack-stack world-state) ess-search-state - - (dbg-lp "~%Saving backtrack state: ~s" tasks) + + (trace-print :loop domain ess-search-state "~%Saving backtrack state: ~s" tasks) (push (make-conditional-state-expand :top-tasks top-tasks :tasks tasks :unifier unifier) backtrack-stack) - - (dbg-lp "~%Start to expand now...") + + (trace-print :loop domain ess-search-state "~%Start to expand now...") (multiple-value-bind (success tasks1 top-tasks1 unifier1) ;one set of dependencies... ;; This should not call SEEK-PLANS anymore... (expand-conditional :ess domain current-task world-state tasks top-tasks @@ -72,7 +72,7 @@ (expand-conditional-body (first task-body) task-body domain state in-unifier nil)) - (dbg-lp "~%Expanded...: ~s" reductions) + (trace-print :loop reductions state "~%Expanded...: ~s" reductions) (setf reductions (remove :ordered reductions)) (unless reductions (return-from expand-conditional (values nil nil nil nil))) @@ -86,7 +86,7 @@ (apply-method-bindings task1 top-tasks tasks reductions in-unifier) - (dbg-lp "~%Top-tasks1: ~s" top-tasks1) + (trace-print :loop reductions state "~%Top-tasks1: ~s" top-tasks1) ;; RETURN: (values t tasks1 top-tasks1 in-unifier)))) @@ -108,8 +108,6 @@ (declare (ignorable search-state)) ;; TASK-BODY is the form (:IF (:COND ....) (:ORDERED ...) (:ELSE...)) - (dbg-lp "~%Hello??") - (let* ((if-condition (block-body-condition :cond task-body)) (unifiers (find-satisfiers if-condition state @@ -133,7 +131,7 @@ (apply-substitution (block-body-item1 :ordered else-body) in-unifier))) - (dbg-lp "~%ELSE tasks: ~s" else-tasks) + (trace-print :loop else-tasks search-state "~%ELSE tasks: ~s" else-tasks) (setf reduction (generate-reduction domain reduction else-tasks)))) reduction)) @@ -158,7 +156,7 @@ (unless reduction (setf reduction `(:ordered (:task !!inop)))) - (dbg-lp "~%WHEN Reduction: ~s" reduction) + (trace-print :loop reduction search-state "~%WHEN Reduction: ~s" reduction) reduction)) (defmethod expand-conditional-body ((body-key (eql :unless)) diff --git a/shop3/looping-tasks/loop-extensions.lisp b/shop3/looping-tasks/loop-extensions.lisp index dd98c5d7..349e9314 100644 --- a/shop3/looping-tasks/loop-extensions.lisp +++ b/shop3/looping-tasks/loop-extensions.lisp @@ -1,13 +1,5 @@ (in-package :shop) -(defparameter *loop-extension-debug* t) -(defparameter *loop-extension-stream* t) - -(defun dbg-lp (str &rest format-arguments) - (when *loop-extension-debug* - (apply #'format *loop-extension-stream* str format-arguments) - (terpri *loop-extension-stream*))) - ;; Extend ESS stack class: (defclass loop-state-expand (stack-entry) ((top-tasks @@ -41,18 +33,18 @@ (defmethod unfold-loop-task ((domain looping-domain) ess-search-state) - (dbg-lp "Unfolding now...~%") + (shop-trace "Unfolding now...~%") (with-slots (top-tasks tasks current-task unifier backtrack-stack world-state) ess-search-state - (dbg-lp "Saving backtrack state...~%") + (trace-print :loop nil ess-search-state "Saving backtrack state...~%") ; (push (make-loop-state-expand :top-tasks top-tasks ; :tasks tasks ; :unifier unifier) ; backtrack-stack) - (dbg-lp "~%Backtrack stack: ~s" backtrack-stack) - (dbg-lp "~%Start to expand now...") + (trace-print :loop backtrack-stack ess-search-state "~%Backtrack stack: ~s" backtrack-stack) + (trace-print :loop nil ess-search-state "~%Start to expand now...") (multiple-value-bind (success tasks1 top-tasks1 unifier1) ;one set of dependencies... ;; This should not call SEEK-PLANS anymore... (expand-loop :ess domain current-task world-state tasks top-tasks @@ -78,7 +70,7 @@ (unless reduction (return-from expand-loop (values nil nil nil nil))) - (dbg-lp "~%Loop reduction: ~s" reduction) + (trace-print :loop reduction ess-search-state "~%Loop reduction: ~s" reduction) (save-reduction ess-search-state reduction) (setf reduction (push :ordered reduction))