Fix errors from rebasing.

shop3/decls.lisp

@@ -89,6 +89,7 @@
 (defvar *operator-tasks*) ; record of the task atom for operators
 (declaim (type hash-table *operator-tasks* *task-operator*))
 (defvar *task-operator*) ; inverse of *operator-tasks*
+(defvar *reduction-labels*)             ; support recording method labels in plan tree
 (defparameter *optimize-cost* nil)  ; whether to optimize with branch and bound
 (defparameter *optimal-plan* 'fail) ; optimal plan found so far
 (defparameter *optimal-cost* 0)     ; cost of *optimal-plan*

shop3/hddl/hddl-plan.lisp

@@ -103,13 +103,3 @@ and prints it to STREAM in the IPC format."
 
 (defun forest-roots (plan-tree)
   (mapcar #'shop:tree-node-task plan-tree))
-
-(declaim (ftype (function (list hash-table) (only-value list))
-                tree-decompositions))
-(defun tree-decompositions (plan-forest task-indices &optional (stream t))
-  (iter (with open = plan-forest)
-    (while open)
-    (as node = (pop open))
-    (if (shop:complex-node-p node)
-        ))
-  )

shop3/package.lisp

@@ -243,7 +243,7 @@
              #:adl-mixin
              #:adl-domain
              #:fluents-mixin
-             
+
 
              ;; MIXIN
              #:pure-logic-domain-mixin
@@ -259,10 +259,13 @@
              #:complex-node-p
              #:complex-node-task
              #:complex-node-children
+             #:complex-node-reduction-label
+             #:complex-node
              #:primitive-node-p
              #:primitive-node-task
              #:primitive-node-cost
              #:primitive-node-position
+             #:primitive-node
              #:remove-internal-operators
              #:tree-node-task
              #:tree-node-task-name
@@ -284,7 +287,7 @@
              #:singleton-variable
              #:incorrect-arity-error
              #:incomplete-dependency-error
-             
+
              ;; things you might want to use in your domain definitions
              #:variablep
 

shop3/planning-tree/tree-accessors.lisp

@@ -54,7 +54,7 @@
 ;;; markings.
 (in-package :shop)
 
-(defstruct (complex-node (:type list) 
+(defstruct (complex-node (:type list)
                          (:constructor make-complex-node (task children &key reduction-label)))
   task
   (reduction-label nil :type symbol)
@@ -328,7 +328,9 @@ tree (although they will be EQUALP."
                                          (primitive-node-task node)
                                          (primitive-node-position node)))
                    ((complex-node-p node)
-                    (copy-complex-node node))
+                    (make-complex-node (complex-node-task node)
+                                       (list-iter (complex-node-children node))
+                                       :reduction-label (complex-node-reduction-label node)))
                    (t
                     (error 'type-error :expected-type 'tree-node :datum node)))))
     ;; Ugh: SHOP plan "trees" are really forests. Most of the time.

shop3/planning-tree/tree-reductions.lisp

@@ -70,11 +70,11 @@
   (let ((all-subtasks (extract-subtasks reduction)))
     (iter (for subtask in all-subtasks)
       (setf (gethash subtask *subtask-parents*)
-            task1)))
+            task1))
     (when method-label
       (alexandria:nconcf *reduction-labels*
                          (mapcar #'(lambda (subtask) (cons subtask method-label))
-                                 all-subtasks))))
+                                 all-subtasks)))))
 
 (defun extract-subtasks (reduction)
   (cond
@@ -99,7 +99,8 @@
 (defun extract-tree (plan)
   (strip-tree-tags
    (let* ((operator-nodes (plan-operator-nodes plan))
-          ;; all-nodes are either operator-nodes or complex tasks
+          ;; all-nodes are either primitive-nodes or complex tasks
+          ;; this is kind of gross...
           (all-nodes (plan-tree-nodes operator-nodes))
           (*node-children-table* (create-node-children-table *subtask-parents* all-nodes operator-nodes))
           (root-tasks (node-children nil *node-children-table*)))
@@ -143,8 +144,7 @@ ROOT-NODE is a PRIMITIVE-NODE."
           (make-complex-node root-node
                              (mapcar #'(lambda (child) (extract-subtree child nodes))
                                      children)
-                             :reduction-label label))
-        root-node)
+                             :reduction-label label)))
       ((primitive-node-p root-node)
        root-node)
       (t
@@ -251,11 +251,6 @@ expanded -- if it is part of a failed search branch then  or (c) TASK itself."
             (extend-plan-tree-nodes (rest base-nodes) (cons node acc))))))
 
 ;;; Introduced an OPERATOR-NODE structure as a way of better
-;;; understanding the TREE extraction code. [2004/02/05:rpg]
-(defstruct (operator-node (:type list))
-  cost
-  operator
-  position)
 
 ;;; I think OPERATOR-TASK here actually applies to an operator NODE...
 ;;; this function is necessary because the operators are not EQ

shop3/shop3.lisp

@@ -168,6 +168,7 @@ MPL/GPL/LGPL triple license.  For details, see the software source file.")
          ;; [mpelican:20090226.1825CST] obsolete, please use state-type arg or default-state-type slot in domain class
          (*state-encoding* :obsolete-state-encoding-variable)
          (*plan-tree* plan-tree)
+         (*reduction-labels* nil)
          (*collect-state* (or collect-state plan-tree))
          (*subtask-parents* (make-subtask-parents-table))
          (*operator-tasks* (make-operator-task-table))