Add HDDL output for ESS SHOP.

shop3/buildapp/Makefile

@@ -6,7 +6,8 @@ shop-app:	buildapp-script shop-app-entrypoints.lisp
 
 install:	shop-app
 	install -c -m 555 shop-app ${DESTDIR}/bin/shop
-	cd ${DESTDIR}/bin && ln -s shop ess-shop && ln -s shop tree-compare
+	install -c -m 555 shop-app ${DESTDIR}/bin/ess-shop
+	install -c -m 555 shop-app ${DESTDIR}/bin/tree-compare
 
 clean:
 	rm -f shop-app

shop3/buildapp/README.md

@@ -0,0 +1,19 @@
+# Building SHOP applications with `buildapp`
+
+`buildapp` is Zach Beane's tool for building stand-alone applications in Common Lisp, compatible with both SBCL and CCL.  For more details, see [its webpage](https://www.xach.com/lisp/buildapp/).
+
+If you have buildapp installed, you can use it to build SHOP-based applications with the contents of this directory.
+
+The applications that can be built are:
+
+- `ess-shop` -- given a domain and a problem, output a plan for the problem using `find-plans-stack`.
+- `shop` -- given a domain and a problem, output a plan for the problem using `find-plans` ("classic SHOP").  Note that this does not offer the full functionality of `ess-shop`.
+- `tree-compare` -- compare two files that contain SHOP planning trees.
+
+# Build instructions
+
+It is sufficient to do `make install` to get the above three applications installed, if `buildapp` is in your `PATH`.  Note that the Makefile supports the standard `DESTDIR` make variable.  For example, I use `make install DESTDIR=~/.local/`
+
+# For assistance
+
+For questions, post discussions in the GitHub SHOP3 project. Report bugs in issues.

shop3/buildapp/shop-app-entrypoints.lisp

@@ -15,7 +15,8 @@
 ;;;
 ;;;---------------------------------------------------------------------------
 (defpackage :shop-app
-  (:use :shop3 :iterate :common-lisp))
+  (:use :shop3 :iterate :common-lisp)
+  (:import-from #:shop-hddl #:hddl-plan))
 (in-package :shop-app)
 
 (defvar *interactive* t
@@ -44,36 +45,53 @@
       (as i from 1)
       (format stream "~3d:~t~a:~t~,2f~%"
               i step cost))
+    (finish-output stream)
     (when (eq stream t)
       (print-separator stream))))
 
-(defun print-ess-tree (tree &optional (stream t))
+(defun print-ess-tree (tree &optional (stream-arg t))
   (let ((*print-length* nil)
         ;; (*print-right-margin* 10000)
         ;; best guess at package for output
-        (*package* (symbol-package (shop::problem-name shop::*problem*))))
+        (*package* (symbol-package (shop::problem-name shop::*problem*)))
+        (stream (if (eq stream-arg t) *standard-output* stream-arg)))
+    ;; print functions
     (pprint (plan-tree:plan-tree->sexp tree) stream)
-    (when (eq stream t)
+    (terpri stream)
+    (finish-output stream)
+    (when (eq stream-arg t)
       (print-separator stream))))
 
-(defun print-classic-tree (tree &optional (stream t))
+(defun print-classic-tree (tree &optional (stream-arg t))
   (let ((*print-length* nil)
         ;; (*print-right-margin* 10000)
         ;; best guess at package for output
-        (*package* (symbol-package (shop::problem-name shop::*problem*))))
+        (*package* (symbol-package (shop::problem-name shop::*problem*)))
+        (stream (if (eq stream-arg t) *standard-output* stream-arg)))
     (pprint tree stream)
     (terpri stream)
-    (force-output stream)
-    (when (eq stream t)
+    (finish-output stream)
+    (when (eq stream-arg t)
       (print-separator stream))))
 
+(defun print-hddl-plan (plan tree &optional (stream-arg t))
+  (let ((hddl-plan (hddl-plan plan tree)))
+    ;; (terpri *error-output*)
+    ;; (pprint hddl-plan *error-output*)
+    ;; (terpri *error-output*)
+    (let ((*print-length* nil)
+          ;; (*print-right-margin* 10000)
+          ;; best guess at package for output
+          (*package* (symbol-package (shop::problem-name shop::*problem*))))
+      (shop-hddl:print-hddl-plan hddl-plan (if (eq stream-arg t) *standard-output* stream-arg)))))
+
+(defun print-pddl-plan (plan domain &optional (stream-arg t))
+  (shop:write-pddl-plan plan :domain domain :stream stream-arg))
+
+
 (defun common/options ()
   (list
-   (clingon:make-option
-    :flag
-    :description "Print plan tree as well as plan."
-    :key :plan-tree
-    :long-name "tree")
+
    (clingon:make-option
     :counter
     :description "Verbose output."
@@ -86,22 +104,39 @@
     :description "Print plan to file."
     :key :plan-file
     :required nil
-    :long-name "plan-file")
+    :long-name "plan-file")))
+
+(defun ess/options ()
+  (append
+   (list
+    (clingon:make-option
+     :flag
+     :description "Print plan in PDDL format."
+     :key :pddl
+     :long-name "pddl"
+     )
+    (clingon:make-option
+    :string
+    :description "Print PDDL output to file."
+    :key :pddl-file
+    :required nil
+    :long-name "pddl-file")
+    (clingon:make-option
+     :flag
+     :description "Print plan tree as well as plan."
+     :key :plan-tree
+     :long-name "tree")
    (clingon:make-option
     :string
     :description "Print plan tree to file."
     :key :tree-file
     :required nil
-    :long-name "tree-file")))
-
-(defun ess/options ()
-  (append
-   (list
+    :long-name "tree-file")
     (clingon:make-option
-    :flag
-    :description "Print HDDL output (plan and tree)."
-    :key :hddl
-    :long-name "hddl")
+     :flag
+     :description "Print HDDL output (plan and tree)."
+     :key :hddl
+     :long-name "hddl")
     (clingon:make-option
     :string
     :description "Print HDDL output to file."
@@ -116,67 +151,96 @@
 (defun tree-compare/options ()
   nil)
 
+(defun load-shop-file (filename)
+  (let ((*package* (find-package :shop-user)))
+    (unless (load filename :if-does-not-exist t)
+      (error "File ~a failed to load." filename))))
+
+;; (eval-when (:load-toplevel :execute)
+;;   (trace shop-hddl::plan-tree->decompositions)
+;;   (trace shop-hddl::forest-roots))
+
+(trace write-pddl-plan)
 
 (defun ess/handler (cmd)
   (let ((args (clingon:command-arguments cmd))
         (plan-tree (or (clingon:getopt cmd :plan-tree)
                        (clingon:getopt cmd :tree-file)))
+        (pddl (or (clingon:getopt cmd :pddl)
+                  (clingon:getopt cmd :pddl-file)))
         (hddl (or (clingon:getopt cmd :hddl)
                   (clingon:getopt cmd :hddl-file)))
+        (verbosity  (clingon:getopt cmd :verbose))
         (shop::*define-silently* (zerop (clingon:getopt cmd :verbose))))
     (handler-bind ((error
                      (lambda (x)
                        (unless *interactive*
-                         (format *error-output* "~a" x)
+                         (format *error-output* "~&ESS-SHOP ERROR:~a~%" x)
+                         #+sbcl(sb-debug:print-backtrace :stream *error-output*)
                          (uiop:quit 1)))))
       (iter (for x in args)
-        (unless (load x :if-does-not-exist t)
-          (error "File ~a failed to load." x)))
+        (load-shop-file x))
 
       (let ((retvals
-              (find-plans-stack shop::*problem* :plan-tree plan-tree :unpack-returns nil :verbose (clingon:getopt cmd :verbose))))
+              (find-plans-stack shop::*problem* :plan-tree (or plan-tree hddl) :unpack-returns nil :verbose verbosity)))
         (unless retvals
           (error "Unable to find a plan for problem ~a"
                  (shop::problem-name shop::*problem*)))
-        (let ((plan-stream (alexandria:if-let ((plan-path (clingon:getopt cmd :plan-file)))
-                             (open plan-path :direction :output :if-exists :supersede)
-                             t)))
-          (unwind-protect
-           (print-plan (shop:plan (first retvals)) plan-stream)
-            (unless (eq plan-stream t) (close plan-stream))))
-        (when plan-tree
-          (let ((stream (alexandria:if-let ((plan-path (clingon:getopt cmd :tree-file)))
-                             (open plan-path :direction :output :if-exists :supersede)
-                             t)))
-          (unwind-protect
-               (print-ess-tree (tree (first retvals)) stream)
-            (unless (eq stream t) (close stream)))))
+
+        (when pddl
+          (let ((domain (find-domain (domain-name shop::*problem*))))
+            (if (clingon:getopt cmd :pddl-file)
+                (write-pddl-plan (plan (first retvals)) :domain domain
+                                                        :filename (clingon:getopt cmd :pddl-file))
+                (write-pddl-plan (plan (first retvals)) :domain domain))))
+
+        ;; print the plan sequence
+        (unless (or hddl pddl)
+          (if (clingon:getopt cmd :plan-file)
+              (let ((plan-stream (open (clingon:getopt cmd :plan-file) :direction :output :if-exists :supersede)))
+                (unwind-protect
+                     (print-plan (shop:plan (first retvals)) plan-stream)
+                  (unless (eq plan-stream t) (close plan-stream))))
+              (print-plan (shop:plan (first retvals)) t))
+
+          ;; print the plan-tree (if appropriate)
+          (when plan-tree
+            (if (clingon:getopt cmd :tree-file)
+                (let ((stream (open (clingon:getopt cmd :tree-file) :direction :output :if-exists :supersede)))
+                  (unwind-protect
+                       (print-ess-tree (tree (first retvals)) stream)
+                    (close stream)))
+                (print-ess-tree (tree (first retvals)) t))))
+
+        ;; print the HDDL, if appropriate
         (when hddl
-          (let ((stream (alexandria:if-let ((plan-path (clingon:getopt cmd :hddl-file)))
-                             (open plan-path :direction :output :if-exists :supersede)
-                             t)))
-            ;;; FIXME: update this...
-            (unwind-protect
-                 (print-ess-tree (tree (first retvals)) stream)
-              (unless (eq stream t) (close stream)))))
-        ))))
+          (let ((plan (plan (first retvals)))
+                (tree (tree (first retvals))))
+            (if (clingon:getopt cmd :hddl-file)
+                (let ((stream
+                        (open (clingon:getopt cmd :hddl-file) :direction :output :if-exists :supersede)))
+                  (unwind-protect
+                       (print-hddl-plan plan tree stream)
+                    (unless (eq stream t) (close stream))))
+                (print-hddl-plan plan tree t))))))))
 
 (defun classic/handler (cmd)
   (let ((args (clingon:command-arguments cmd))
-        (plan-tree (or (clingon:getopt cmd :plan-tree)
-                       (clingon:getopt cmd :tree-file)))
+        ;; (plan-tree (or (clingon:getopt cmd :plan-tree)
+        ;;                (clingon:getopt cmd :tree-file)))
         (shop::*define-silently* (zerop (clingon:getopt cmd :verbose))))
     (handler-bind ((error
                      (lambda (x)
                        (unless *interactive*
                          (format *error-output* "~a" x)
                          (uiop:quit 1)))))
       (iter (for x in args)
-        (unless (load x :if-does-not-exist t)
-          (error "File ~a failed to load." x)))
-      (multiple-value-bind (plans time trees)
-          (find-plans shop::*problem* :plan-tree plan-tree :verbose (clingon:getopt cmd :verbose))
-        (declare (ignore time))     ; at least for now...
+        (load-shop-file x))
+      (multiple-value-bind (plans ;; time trees
+                            )
+          (find-plans shop::*problem* :plan-tree nil ;plan-tree
+                                      :verbose (clingon:getopt cmd :verbose))
+        ;;(declare (ignore time))     ; at least for now...
         (unless plans
           (error "Unable to find a plan for problem ~a"
                  (shop::problem-name shop::*problem*)))
@@ -186,20 +250,21 @@
           (unwind-protect
                (print-plan (first plans) plan-stream)
             (unless (eq plan-stream t) (close plan-stream))))
-        (when plan-tree
-          (let ((stream (alexandria:if-let ((plan-path (clingon:getopt cmd :tree-file)))
-                          (open plan-path :direction :output :if-exists :supersede)
-                          t)))
-            (unwind-protect
-                 (print-classic-tree (first trees) stream)
-              (unless (eq stream t) (close stream)))))))))
+        ;; (when plan-tree
+        ;;   (let ((stream (alexandria:if-let ((plan-path (clingon:getopt cmd :tree-file)))
+        ;;                   (open plan-path :direction :output :if-exists :supersede)
+        ;;                   t)))
+        ;;     (unwind-protect
+        ;;          (print-classic-tree (first trees) stream)
+        ;;       (unless (eq stream t) (close stream)))))
+        ))))
 
 (defun tree-compare/handler (cmd)
   (let ((args (clingon:command-arguments cmd)))
     (handler-bind ((error
                      (lambda (x)
                        (unless *interactive*
-                         (format *error-output* "~a" x)
+                         (format *error-output* "TREE-COMPARE ERROR: ~a" x)
                          (uiop:quit 2)))))
       (flet ((load-file (filename)
                (uiop:with-input-file (str filename :if-does-not-exist :error)
@@ -210,8 +275,8 @@
                  cmd args))
         (let ((tree1 (load-file (first args)))
               (tree2 (load-file (second args))))
-          (setf tree1 (shop::canonically-order tree1)
-                tree2 (shop::canonically-order tree2))
+          (setf tree1 (shop::canonically-order-plan-tree tree1)
+                tree2 (shop::canonically-order-plan-tree tree2))
           (cond ((equalp tree1 tree2)
                  (format t "~&Trees match.~%")
                  (uiop:quit 0))