Plan transformations: failure handling by code replacement and task tree (de)serialization that can restore (some) functions.

cram_execution_trace/cram-execution-trace.asd

@@ -26,6 +26,7 @@
      (:file "offline-task" :depends-on ("package"))
      (:file "episode-knowledge-backend" :depends-on ("package" "episode-knowledge" "offline-task"))
      (:file "serialize" :depends-on ("package" "episode-knowledge" "episode-knowledge-backend"))
+     (:file "task-tree-serialize")
      (:file "interface" :depends-on ("package" "episode-knowledge" "serialize"))
      (:module "episode-knowledge"
               :depends-on ("package" "utils")

cram_execution_trace/src/package.lisp

@@ -79,4 +79,7 @@
    #:auto-tracing-enabled
    #:set-auto-tracing-directory
    #:setup-auto-tracing
+   ;; task tree serialization
+   #:store-tree
+   #:restore-tree
    ))

cram_execution_trace/src/task-tree-serialize.lisp

@@ -0,0 +1,35 @@
+;;;
+;;; Copyright (c) 2015
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions are met:
+;;;
+;;;     * Redistributions of source code must retain the above copyright
+;;;       notice, this list of conditions and the following disclaimer.
+;;;     * Redistributions in binary form must reproduce the above copyright
+;;;       notice, this list of conditions and the following disclaimer in the
+;;;       documentation and/or other materials provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+;;; POSSIBILITY OF SUCH DAMAGE.
+;;;
+
+(in-package #:cram-execution-trace)
+
+(defun store-tree (tree filename) 
+  (let ((newtree (cpl-impl:clear-illegal-function-names tree)))
+       (cl-store:store newtree filename)))
+
+(defun restore-tree (filename)
+  (cl-store:restore filename))
+

cram_language/cram-language.asd

@@ -40,6 +40,7 @@
       :components
       ((:file "fluent")
        (:file "value-fluent" :depends-on ("fluent"))
+       (:file "latch-fluent" :depends-on ("fluent"))
        (:file "fluent-net" :depends-on ("fluent"))
        (:file "pulse-fluent" :depends-on ("fluent"))))
      ;; WALKER
@@ -55,6 +56,8 @@
      ;; CRAM, The Language
      (:file "language" :depends-on ("packages" "walker" "tasks" "fluents" "logging" "with-policy" "default-policies"))
      (:file "plans" :depends-on ("packages" "tasks"))
+     (:file "ptr-language" :depends-on ("packages" "language" "plans"))
+     (:file "ptr-goals" :depends-on ("packages" "ptr-language"))
      (:file "goals" :depends-on ("packages" "tasks"))
      (:file "fluent-operators" :depends-on ("packages" "fluents"))
      (:file "swank-indentation" :depends-on ("packages"))))))

cram_language/src/fluents/latch-fluent.lisp

@@ -0,0 +1,83 @@
+;;;
+;;; Copyright (c) 2015, Mihai Pomarlan <mpomarlan@yahoo.co.uk>,
+;;; All rights reserved.
+;;; 
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions are met:
+;;; 
+;;;     * Redistributions of source code must retain the above copyright
+;;;       notice, this list of conditions and the following disclaimer.
+;;;     * Redistributions in binary form must reproduce the above copyright
+;;;       notice, this list of conditions and the following disclaimer in the
+;;;       documentation and/or other materials provided with the distribution.
+;;;     * Neither the name of Willow Garage, Inc. nor the names of its
+;;;       contributors may be used to endorse or promote products derived from
+;;;       this software without specific prior written permission.
+;;; 
+;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+;;; POSSIBILITY OF SUCH DAMAGE.
+;;;
+
+(in-package :cpl-impl)
+
+(defclass latch-fluent (value-fluent)
+           ((monitored-fluent :initarg :monitored-fluent
+                              :initform nil 
+                              :reader monitored-fluent
+                              :writer (setf monitored-fluent)
+                              :documentation "Boolean fluent. When it becomes true, the latch fluent is set to true.")))
+
+(defun setup-latch-fluent (monitored-fluent)
+  "Creates a latch fluent over a monitored fluent.
+   When monitored-fluent becomes non-NIL, the latch fluent will become T.
+   The latch fluent must be manually reset to NIL afterwards."
+  (let* ((lf (cpl:make-fluent :name :latch-fluent :class 'latch-fluent :value nil))
+         (sf (cpl:fl-funcall (lambda (sig) 
+                               (if (cpl:value sig)
+                                   (setf (cpl:value lf) T))
+                               (cpl:value sig))
+                             monitored-fluent)))
+    (setf (monitored-fluent lf) sf)
+    lf))
+
+(defun setup-accumulator-fluent (monitored-fluent accumulator-function &optional (init-value nil))
+  "Creates an accumulator fluent over a monitored fluent. Accumulation is done by accumulator-function,
+which must be of the form
+
+(lambda (monitored-value accumulated-value) &body)
+
+and returning a value of type compatible with accumulated-value.
+
+init-value is by default NIL. It is strongly recommended to provide an explicit starting value however,
+because not all types of accumulated values are compatible with NIL (for example, REAL isn't).
+
+EXAMPLE: setting up a MAX fluent, which stores the maximum value reached by some other fluent.
+
+(defun acc-max (new-val old-val)
+  (if (< old-val new-val)
+    new-val
+    old-val))
+
+(setup-accumulator-fluent monitored-fluent #'acc-max 0)
+
+NOTE: when setting an accumulator fluent, make sure the monitored-fluent has a reasonable value.
+
+For some fluents it is ok if this initial value is NIL (therefore, we can't use wait-for here).
+In some cases however, for example when a monitored-fluent should contain a number, then having
+a NIL value while setting up the accumulator will cause an error."
+  (let* ((lf (cpl:make-fluent :name :accumulator-fluent :class 'latch-fluent :value init-value))
+         (sf (cpl:fl-funcall (lambda (sig)
+                               (setf (cpl:value lf) (funcall accumulator-function (cpl:value sig) (cpl:value lf))))
+                             monitored-fluent)))
+  (setf (monitored-fluent lf) sf)
+  lf))
+

cram_language/src/packages.lisp

@@ -93,6 +93,9 @@
            ;; fluent.lisp
            #:fluent
            #:value-fluent
+           #:latch-fluent
+           #:setup-latch-fluent
+           #:setup-accumulator-fluent
            #:value
            #:peek-value
            #:wait-for
@@ -149,12 +152,69 @@
            #:fail #:on-fail
            #:simple-plan-failure
            #:plan-failure
-           #:with-failure-handling #:retry
+           #:plan-failure/get-code-path
+           #:with-failure-handling #:with-transformative-failure-handling #:retry
            #:with-retry-counters #:do-retry #:reset-counter #:get-counter
            #:common-lisp-error-envelope
            #:envelop-error
            #:*break-on-plan-failures*
            #:*debug-on-lisp-errors*
+           ;; ptr-function versions of plan macros
+           #:ptr-failure
+           #:ptr-circular-partial-order
+           #:ptr-malformed-partial-order
+           #:ptr-failure/message
+           #:ptr-failure/cdeps
+           #:ptr-failure/deps-issue
+           #:ptr-tag
+           #:ptr-tag/name
+           #:ptr-tag/fluent-object
+           #:ptr-tag/task-object
+           #:wait-for-ptr-tag
+           #:ptr-seq
+           #:ptr-try-in-order
+           #:ptr-with-task
+           #:ptr-with-task-suspended
+           #:ptr-try-each-in-order
+           #:ptr-par
+           #:ptr-pursue
+           #:ptr-try-all
+           #:ptr-par-loop
+           #:ptr-partial-order
+           #:get-dependent-partial-order-tasks
+           #:delete-partial-order-task
+           #:get-deps-result
+           #:function-application
+           #:function-application/task-tag
+           #:function-application/function-object
+           #:function-application/par-list
+           #:function-application-list
+           #:function-application-list/fn-list
+           #:make-fn-app-list
+           #:with-task-ptr-parameter
+           #:with-task-ptr-parameter/function-application
+           #:with-task-ptr-parameter/class
+           #:with-task-ptr-parameter/name
+           #:try-each-ptr-parameter
+           #:try-each-ptr-parameter/task-tag
+           #:try-each-ptr-parameter/function-object
+           #:try-each-ptr-parameter/options-list
+           #:make-try-each-ptr-par
+           #:partial-order-ptr-parameter
+           #:partial-order-ptr-parameter/fn-apps
+           #:partial-order-ptr-parameter/orderings
+           ;; ptr-goals
+           #:fluent-condition-failure
+           #:goal-recipes-failed
+           #:goal-pattern-not-found
+           #:goal-recipe-not-found
+           #:fmp/name
+           #:ptr-declare-goal
+           #:ptr-add-goal-pattern
+           #:ptr-add-goal-recipe
+           #:ptr-adjust-recipe-score
+           #:ptr-remove-recipe
+           #:ptr-clear-patterns
            ;; task-tree.lisp
            #:code
            #:code-parameters
@@ -171,6 +231,9 @@
            #:with-task-tree-node
            #:make-task-tree-node
            #:replaceable-function
+           #:replace-task-ptr-parameter
+           #:replace-task-code
+           #:get-ptr-parameter
            #:make-task
            #:sub-task
            #:task
@@ -186,6 +249,9 @@
            #:goal-task-tree-node-pattern
            #:goal-task-tree-node-parameter-bindings
            #:goal-task-tree-node-goal
+           #:*in-projection-environment*
+           #:*projection-signal-data*
+           #:*retry-path*
            ;; base.lisp
            #:top-level #:seq #:par #:tag #:with-tags #:with-task-suspended
            #:par-loop
@@ -197,7 +263,7 @@
            ;; plans.lisp
            #:on-def-top-level-plan-hook
            #:def-top-level-plan #:get-top-level-task-tree #:def-plan
-           #:def-cram-function #:def-top-level-cram-function
+           #:def-cram-function #:def-top-level-cram-function #:def-ptr-cram-function
            ;; goals.lisp
            #:declare-goal #:def-goal #:goal #:register-goal #:goal-context
            #:succeed #:describe-goal))
@@ -222,6 +288,8 @@
            #:log-enable
            #:log-disable
            #:log-set
+           ;; task tree utils
+           #:clear-illegal-function-names
            ;; tasks
            #:name
            #:*save-tasks*

cram_language/src/plans.lisp

@@ -65,25 +65,56 @@
               :format-control "Use of deprecated form DEF-TOP-LEVEL-PLAN. Please use DEF-TOP-LEVEL-CRAM-FUNCTION instead.")
   `(def-top-level-cram-function ,name ,lambda-list ,@body))
 
+(defmacro def-cram-function-base (name lambda-list is-ptr-task &rest body)
+  (with-gensyms (call-args)
+    (multiple-value-bind (body-forms declarations doc-string)
+        (parse-body body :documentation t)
+      (let* ((op (if is-ptr-task
+                     (list 'replaceable-ptr-function 'ptr-parameter)
+                     (list 'replaceable-function))))
+        `(progn
+           (eval-when (:load-toplevel)
+             (setf (get ',name 'plan-type) :plan)
+             (setf (get ',name 'plan-lambda-list) ',lambda-list)
+             (setf (get ',name 'plan-sexp) ',body))
+           (defun ,name (&rest ,call-args)
+             ,doc-string
+             ,@declarations
+             (let* ((ptr-parameter (car ,call-args)))
+               (declare (ignorable ptr-parameter))
+               (,@op ,name ,lambda-list ,call-args (list ',name)
+                 (with-tags
+                   ,@body-forms))))))))) 
+
 (defmacro def-cram-function (name lambda-list &rest body)
   "Defines a cram function. All functions that should appear in the
-   task-tree must be defined with def-cram-function.
+   task-tree must be defined with def-cram-function (or def-ptr-cram-function).
 
    CAVEAT: See docstring of def-top-level-cram-function."
-  (with-gensyms (call-args)
-    (multiple-value-bind (body-forms declarations doc-string)
-        (parse-body body :documentation t)
-      `(progn
-         (eval-when (:load-toplevel)
-           (setf (get ',name 'plan-type) :plan)
-           (setf (get ',name 'plan-lambda-list) ',lambda-list)
-           (setf (get ',name 'plan-sexp) ',body))
-         (defun ,name (&rest ,call-args)
-           ,doc-string
-           ,@declarations
-           (replaceable-function ,name ,lambda-list ,call-args (list ',name)
-             (with-tags
-               ,@body-forms)))))))
+  `(def-cram-function-base ,name ,lambda-list nil ,@body))
+
+(defmacro def-ptr-cram-function (name lambda-list &rest body)
+  "Defines a cram function. All functions that should appear in the
+   task-tree must be defined with def-cram-function (or def-ptr-cram-function).
+
+   CAVEAT: See docstring of def-top-level-cram-function.
+
+   Difference to def-cram-function: MUST have at least one argument in the lambda
+   list. First argument in lambda list is extracted and passed as ptr-parameter.
+
+   When a ptr-cram-function is first called (there is no corresponding task tree
+   node) then the value of the ptr-parameter slot in the newly created node is
+   set to the value of the first parameter.
+
+  When a ptr-cram-function is called and a corresponding node exists in the task
+  tree, then the first parameter in the lambda list is replaced by the ptr-param
+  stored in the task tree.
+
+  (Corresponding node here means a node in the task tree at a path corresponding
+  to the place where the function was called inside the program. It might be the
+  case that a cram function gets called several times in a plan, then each place
+  gets a node.)"
+  `(def-cram-function-base ,name ,lambda-list T ,@body))
 
 (defmacro def-plan (name lambda-list &rest body)
   (style-warn 'simple-style-warning