;;;***********************************************************

;;;  Code for defining and executing MACRO-ACTIONS (macrops).

;;;  A macrop is a single input form, e.g. (PICKUP ?ARM ?BAY ?POSITION)

;;;  that expands into a list of output forms ((ARM-MOVE ?ARM INSIDE) 

;;;    (ARM-MOVE ?ARM ?BAY) ...)

;;;  The matching process takes a ground form as input, e.g. 

;;;  (PICKUP ARM-1 BAY-2 4).  It searches the IN-FORM fields of all 

;;;  defined macrops for one that matches the input form.  When it 

;;;  finds one, it makes copies of the output forms, instantiates the 

;;;  variables, and returns the new list.



;;;  The list of all defined macrops

(defvar *macrops*)



(defstruct macrop

  in-form

  out-forms)



;;;********************************************************



;;; Make an instance and put it on a global list

(defun define-macrop (&key in-form out-forms)

  (push (make-macrop :in-form in-form :out-forms out-forms)

	*macrops*))



;;; To execute a macrop, first match it, then call a truckworld

;;; interface function to execute the resulting primitives.



(defun execute-macrop (form-in)

  (let ((forms-out (match-macrop form-in *macrops*)))

   (cond

    ((null forms-out)

     (error "Couldn't find a match for ~a~%" form-in))

    (T (debug-output :MACROPS "About to execute macrop ~a => ~a~%" form-in forms-out)

       (ti-execute-commands forms-out)))))



;;;  To match a macrop with an input form, first find one that matches the 

;;;  in-form.  Match returns a binding list that is then used to instantiate

;;;  all the out-forms.



;;;**************************************************************
;;;  Solution to #5
;;;
;;;  A subtle change to match-macrop makes this pretty straightforward:
;;;  if we don't find a match, we will just return the form itself.
;;;  Then all we have to do is recursively call MATCH-MACROP on 
;;;  all the output forms after we find a match.

(defun match-macrop (form-in macrops)
  (cond
   ((null macrops) (list form-in))
   (T (let ((bindings (match form-in (macrop-in-form (first macrops)))))
        (cond
         ((eq bindings :FAIL)
          (match-macrop form-in (cdr macrops)))
         (T (expand-out (mapcar #'(lambda (form) (copy-and-instantiate form 
                                                  bindings)) 
                                (macrop-out-forms (first macrops))))))))))

(defun expand-out (form-list)
  (cond
   ((null form-list) '())
   (T (append (match-macrop (first form-list) *macrops*)
              (expand-out (cdr form-list))))))