diff --git a/hddl-to-json-entrypoint.lisp b/hddl-to-json-entrypoint.lisp index 00b7199..d8f14f0 100644 --- a/hddl-to-json-entrypoint.lisp +++ b/hddl-to-json-entrypoint.lisp @@ -1,5 +1,43 @@ (in-package :common-lisp-user) +(defun usage (program-name) + (format *error-output* "~a [input-file [output-file]]~%" program-name) + (format *error-output* "Translate input HDDL into output JSON.~%") + (format *error-output* "If no command line arguments are present, reads from stdin and writes to stdout.~%") + (format *error-output* "If one command line argument is present, reads from argument file and writes to the same name, but with \".json\" extension.~%") + (format *error-output* "If two command line arguments are present, reads from first argument file and writes to second argument file.~%") + (finish-output *error-output*)) + (defun main (argv) - (declare (ignore argv)) - (hddl-json:hddl-to-json *standard-input* *standard-output*)) + (let (output-name + (tmpfile (unless (= (length argv) 1) + (uiop:with-temporary-file (:pathname pn) + pn)))) + (case (length argv) + (1 ; just the program name + (hddl-json:hddl-to-json *standard-input* *standard-output*)) + (2 ; just the input file name + (let* ((filename (second argv)) + (pathname (parse-namestring filename)) + (outfile (merge-pathnames (make-pathname :type "json") + pathname))) + (unless (probe-file filename) + (uiop:die 1 "Unable to open input HDDL file ~a" filename)) + (uiop:with-input-file (in pathname :if-does-not-exist :error) + (uiop:with-output-file (out tmpfile :if-exists :supersede) + (hddl-json:hddl-to-json in out))) + (setf output-name outfile))) + (3 + (let ((filename (second argv)) + (outfile (third argv))) + (unless (probe-file filename) + (uiop:die 1 "Unable to open input HDDL file ~a" filename)) + (uiop:with-input-file (in filename :if-does-not-exist :error) + (uiop:with-output-file (out tmpfile :if-exists :supersede) + (hddl-json:hddl-to-json in out))) + (setf output-name outfile))) + (otherwise + (usage (first argv)) + (uiop:die 1 "Incorrect invocation: ~a requires 0, 1 or 2 arguments."))) + (when output-name (uiop:with-output-file (str output-name :if-exists :supersede) + (uiop:run-program `("jq" "." ,(namestring tmpfile)) :output (list str :linewise t)))))) diff --git a/hddl-utils/commons.lisp b/hddl-utils/commons.lisp index d7683bf..24bf376 100644 --- a/hddl-utils/commons.lisp +++ b/hddl-utils/commons.lisp @@ -54,7 +54,8 @@ :actions actions))) (defun make-problem (name &key requirements domain objects init goal - (complete-p t)) + htn + (complete-p t)) "Make a new PDDL problem s-expression initialized as per the keyword arguments. Unless COMPLETE-P is NIL, will check for mandatory components." (when complete-p @@ -63,6 +64,7 @@ arguments. Unless COMPLETE-P is NIL, will check for mandatory components." (flet ((negated (fact) (eq (first fact) 'not))) (let ((domain (hddl-symbol domain)) (objects (hddlify-tree objects)) + (htn (hddlify-tree htn)) (init (hddlify-tree init)) (goal (hddlify-tree goal))) (when (some #'negated init) @@ -74,12 +76,22 @@ arguments. Unless COMPLETE-P is NIL, will check for mandatory components." "Some duplicated facts in init. This is known to break some planners.") (setf init (remove-duplicates init :test 'equal))) `(,(pddl-symbol 'pddl:define) (,(pddl-symbol 'pddl:problem) ,(hddl-symbol name)) - (:domain ,domain) - ,@(when requirements - `((:requirements ,@requirements))) - (:objects ,@objects) - (:init ,@init) - (:goal ,goal))))) + (:domain ,domain) + ,@(when requirements + `((:requirements ,@requirements))) + (:objects ,@objects) + (:init ,@init) + (:htn ,@htn) + (:goal ,goal))))) + +(defun canonicalize-problem (problem) + (make-problem (problem-name problem) + :requirements (problem-requirements problem) + :domain (problem-domain problem) + :objects (problem-objects problem) + :init (problem-state problem) + :goal (problem-goal problem) + :htn (problem-htn problem))) ;;; misc utility @@ -192,6 +204,13 @@ arguments. Unless COMPLETE-P is NIL, will check for mandatory components." (defun problem-htn (problem) (problem-element problem :htn)) +(defsetf problem-htn (problem) (&rest htn) + `(let ((*pddl-package* hddl-io::*hddl-package*)) + + (setf (pddl-utils:problem-element ,problem :htn) + (hddlify-tree ,htn)))) + + (defun domain-tasks (domain) (check-type domain domain) (remove-if-not #'(lambda (x) (eq x :task)) diff --git a/hddl-utils/package.lisp b/hddl-utils/package.lisp index bde8b1e..4e25e2f 100644 --- a/hddl-utils/package.lisp +++ b/hddl-utils/package.lisp @@ -93,5 +93,6 @@ #:hddl-plan-to-pddl-plan #:hddl-domain-to-pddl-domain #:hddl-problem-to-pddl-problem + #:canonicalize-problem ) ) diff --git a/utils/commons.lisp b/utils/commons.lisp index 78f3884..f3244f5 100644 --- a/utils/commons.lisp +++ b/utils/commons.lisp @@ -48,6 +48,18 @@ problem))) (rest head))) +(defsetf problem-element (problem pddl-keyword) (new-element) + (let ((cell-var (gensym))) + `(progn + (assert (problem-p ,problem)) + (alexandria:if-let ((,cell-var (find-if #'(lambda(e) + (and (listp e) (eq (car e) ,pddl-keyword))) + ,problem))) + (setf (cdr ,cell-var) ,new-element) + (nconc ,problem (quote ((,pddl-keyword ,@new-element)))) + ,new-element)))) + + ;; Getter/setter functions for PDDL expressions: (defun domain-element (domain-expr pddl-keyword) (assert (domain-p domain-expr))