diff --git a/hddl-utils/commons.lisp b/hddl-utils/commons.lisp index e628f5f..1dc6af6 100644 --- a/hddl-utils/commons.lisp +++ b/hddl-utils/commons.lisp @@ -73,7 +73,8 @@ arguments. Unless COMPLETE-P is NIL, will check for mandatory components." (when complete-p (unless domain (error "DOMAIN argument is mandatory.")) - (unless goal (error "GOAL argument is mandatory."))) + ;; (unless goal (error "GOAL argument is mandatory.")) + ) (flet ((negated (fact) (eq (first fact) 'not))) (let ((domain (hddl-symbol domain)) (objects (hddlify-tree objects)) @@ -157,7 +158,7 @@ arguments. Unless COMPLETE-P is NIL, will check for mandatory components." `(:method ,method-name :parameters ,(copy-tree params) :task ,task-sexpr :precondition ,(copy-tree precond) - :ordered-subtasks (and ,@(copy-tree tasks)))) + :ordered-subtasks ,(flatten-conjunction (copy-tree tasks) nil))) (defun method-subtasks (method) (cond ((find :ordered-subtasks method) @@ -169,7 +170,8 @@ arguments. Unless COMPLETE-P is NIL, will check for mandatory components." (t (error "Unable to find subtasks in method definition:~%~s" method)))) (defsetf method-subtasks (method) (subtasks) - `(let ((subtasks (hddlify-tree ,subtasks))) + `(let ((subtasks (when subtasks ; nil is just nil... + (flatten-conjunction (hddlify-tree ,subtasks) nil)))) (cond ((getf ,method :ordered-subtasks nil) (setf (getf ,method :ordered-subtasks) subtasks)) ((getf ,method :tasks nil) diff --git a/utils/commons.lisp b/utils/commons.lisp index f5d66b8..5fd0af0 100644 --- a/utils/commons.lisp +++ b/utils/commons.lisp @@ -618,7 +618,10 @@ removed). Special cases: 1. NIL should yield (AND) 2. Simple proposition ( *) should be wrapped in AND as - (AND ( *))" + (AND ( *)) + 3. Implicit conjunction (( *)+) should be turned into +a standard (explicit) conjunction. + If STRICT is non-NIL, then cases 2 and 3 should raise an error." (labels ((flatten-conj-list (cl) (alexandria:mappend #'flatten-1 cl)) (flatten-1 (conj) @@ -640,8 +643,9 @@ removed). (if strict (error "FLATTEN-CONJUNCTION expects a conjunction, but got a proposition: ~s" conj) `(and ,conj))) - (strict (error "FLATTEN-CONJUNCTION expects a conjunction as input, not an implicit conjunction.")) + (strict + (error "FLATTEN-CONJUNCTION expects a conjunction, but got an IMPLICIT conjunction (list of conjuncts):~%~s" conj)) (t ;; in this case we have an implicit conjunction with no initial 'and - ;; supply one. + ;; and this is *not* strict-mode. supply an 'and. `(and ,@(flatten-conj-list conj)))))) diff --git a/utils/tests/domain-test.lisp b/utils/tests/domain-test.lisp index 3c6e35b..bf01a9d 100644 --- a/utils/tests/domain-test.lisp +++ b/utils/tests/domain-test.lisp @@ -221,18 +221,20 @@ (test flatten-conjunction - (is - (equalp *conjunction* - (flatten-conjunction *conjunction*))) - (is - (equalp *flattened-nested-conjunction* - (flatten-conjunction *nested-conjunction*))) - (is (equalp *conjunction* - (flatten-conjunction (rest *conjunction*) nil))) - (is (equalp '(and) (flatten-conjunction nil nil))) - (is (equalp '(and (hunt snark)) - (flatten-conjunction '(hunt snark) nil))) - ;; check strict mode - (signals error (flatten-conjunction '(hunt snark) t)) - (signals error (flatten-conjunction (rest *conjunction*) t)) - ) + (is + (equalp *conjunction* + (flatten-conjunction *conjunction*))) + (is + (equalp *flattened-nested-conjunction* + (flatten-conjunction *nested-conjunction*))) + (is (equalp *conjunction* + (flatten-conjunction (rest *conjunction*) nil))) + (is (equalp '(and) (flatten-conjunction nil nil))) + (is (equalp '(and (hunt snark)) + (flatten-conjunction '(hunt snark) nil))) + (is (equalp *explicitified-conjuction* + (flatten-conjunction *implicit-conjuction* nil))) + ;; check strict mode + (signals error (flatten-conjunction '(hunt snark) t)) + (signals error (flatten-conjunction (rest *conjunction*) t)) + (signals error (flatten-conjunction *implicit-conjuction*) t)) diff --git a/utils/tests/pddl-data.lisp b/utils/tests/pddl-data.lisp index 24dce46..d62c94f 100644 --- a/utils/tests/pddl-data.lisp +++ b/utils/tests/pddl-data.lisp @@ -5,14 +5,14 @@ (pddlify-tree ',sexp))) (def-pddl-data pddl-utils-tests::*pddl-keywords* - (:adl :strips - :typing + (:adl :strips + :typing :negative-preconditions :disjunctive-preconditions :equality :existential-preconditions :universal-preconditions - :quantified-preconditions + :quantified-preconditions :existential-preconditions :universal-preconditions :conditional-effects @@ -377,3 +377,14 @@ (not (toll-area ?l1)) (road ?l1 ?l2) (l10-0))) + +(def-pddl-data *implicit-conjuction* + ((foo bar) + (baz bletch bongle) + (bill fred))) + +(def-pddl-data *explicitified-conjuction* + (and + (foo bar) + (baz bletch bongle) + (bill fred))) diff --git a/version.lisp-expr b/version.lisp-expr index 038707f..6de0cb6 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"3.2.1" +"3.2.2"