Replace dbg-lp with trace-print

shop-planner · Aug 24, 2023 · ee93b76 · ee93b76
1 parent a61ba7a
commit ee93b76
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 25 deletions.
diff --git 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
@@ -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
@@ -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))