(progn  
(setq start t)

(pprint ucpop::*search-limit*)
(labels ((fields-adjacent? (x1 y1 x2 y2)
	   (or (and (or (equal (- x1 x2) 1)  (equal (- x1 x2) -1))
		    (equal y1 y2))
	       (and (or (equal (- y1 y2) 1)  (equal (- y1 y2) -1))
		    (equal x1 x2))))
	 (field2name (x1 x2)
	   (make-symbol 
	    (concatenate 'string "x" 
			 (format nil "~S" x1) "y" 
			 (format nil "~S" x2)))
	   )
	 (name2field (symb) 
	   (list 
	    (parse-integer 
	     (substring (symbol-name symb) 1 2)) 
	    (parse-integer (substring (symbol-name symb) 3 4)))
	   )
	 (fields-adjacent? (x1 y1 x2 y2)
	   (or (and (or (equal (- x1 x2) 1)  
			(equal (- x1 x2) -1))
		    (equal y1 y2))
	       (and (or (equal (- y1 y2) 1)  
			(equal (- y1 y2) -1))
		    (equal x1 x2))))
	 (determine-adjacent-fields (l)
	   (remove-if #'null 
		      (mapcan 
		       (lambda (x) 
			 (mapcar (lambda (y)
				   (if (fields-adjacent? 
					(car (name2field x))  
					(cadr (name2field x))  
					(car (name2field y))
					(cadr (name2field y))
					)
				       (concatenate 'string 
					 "(adjacent " 
					 (symbol-name x) 
					 " " 
					 (symbol-name y) ") ")
				     ))
				 l)) 
		       l)))
	 (action2squirrel-action 
	     (description)
	   (cond ((equal (symbol-name (car description)) 
			 "PICKUP-NUT")  
		  "(s1 take n1)")
		 ((equal (symbol-name (car description)) 
			 "PUTDOWN-NUT") 
		  "(s1 drop n1)")
		 ((equal (symbol-name (car description)) 
			 "MOVE-TO") (concatenate 'string  
				      "(s1 go " 
				      (format nil "~S" 
					      (name2field 
					       (caddr description))) ")"))
		 (t (error "action2squirrel-action: action unknown~%"))	   
		 ))
	    (execute-squirrel-action()
	      (if (null plan*actions) NIL
		(prog1 
		    (action2squirrel-action (car plan*actions))
		  (setq plan*actions (rest plan*actions)))))
	    (get-plan (plan)
	    (setq steps-in-plan NIL)
	    (let ((steps (make-array (+ 1 (UCPOP::plan-high-step plan))))
		  (order (UCPOP::top-sort (UCPOP::plan-ordering plan) 
			 (UCPOP::plan-high-step plan))))  
	      (dolist (step-n (UCPOP::plan-steps plan))
		(cond 
	     ((eql (UCPOP::p-step-id step-n) :Goal)
	      (setf goal (UCPOP::p-step-precond step-n)))
	     (t
	      (setf (aref steps  (UCPOP::p-step-id step-n)) step-n))))
	      (dotimes (i (UCPOP::plan-high-step plan))
	     (let* ((sn (nth i order))
		    (step (aref steps sn)))
	       (when step
		 (setf steps-in-plan (cons 
				      (VARIABLE::bind-variable (UCPOP::p-step-action step)
						     (UCPOP::plan-bindings plan))
				      steps-in-plan)
				      ))		       		     
	       )))
 (reverse steps-in-plan)
	    )
	 (output-to-description (o) 
	   (let* ((mapdesc 
		   (find-if 
		    (lambda (x) (equal (symbol-name (car x)) "MAP")) 
		    o)
		   ) 
		  (objdesc 
		   (find-if 
		    (lambda (x) 
		      (equal (symbol-name (car x)) "OBJDESC")) 
		    o))
		  (miscobjdesc 
		   (find-if 
		    (lambda (x) 
		       (and (consp x) (equal (symbol-name (car x)) "MISCOBJ"))) 
		    objdesc))
		  (ownobject
		   (find-if 
		    (lambda (x) 
		      (and (consp x) (equal (symbol-name (car x)) "OWNOBJ"))) 
		    objdesc))
		  (squirreldesc 
		   (reduce (lambda (y z) (concatenate 'string y z))
		   (remove-if #'null 
			      (mapcar 
			       (lambda (x) 
				 (if (equal (symbol-name (car x)) "SQUIRREL")
				     (concatenate 'string "(at squirrel "  
						  (symbol-name 
						   (field2name 
						    (car (cadddr (cdr x))) 
						    (cadr (cadddr (cdr x)))))
					   ") "
					   ))
				 ) 
			       (rest ownobject)))))
		  (owngp
		   (find-if 
		    (lambda (x) 
		      (and (consp x) (equal (car x) 'owngp)))
		    objdesc))
		  (gpdesc 
		   (car 
		    (remove-if 
		     #'null 
		     (mapcar (lambda (x) 
			       (if (equal (symbol-name (car x)) "OWNGP")
				   (concatenate 'string "(at nut " 
						(symbol-name 
						 (field2name 
						  (car (caddr  x)) 
						  (cadr (caddr  x)))) ")"))
			       ) (rest ownobject)))))
		  (fields 
		   (mapcar 
		    (lambda (x) 
		      (field2name (car (car x)) 
				  (cadr (car x)))
		      ) (rest mapdesc)))
		  (field-objects 
		   (reduce 
		    (lambda (y z) (concatenate 'string y z))
		   (mapcan 
		    (lambda (x) 
		      (let* ((fieldname (field2name (car (car x)) 
						    (cadr (car x))))
			     (objects (cdr x)))
			(mapcan (lambda (y) 
				  (mapcar (lambda (z) 
					    (if (equal 
						 (subseq (symbol-name z) 0 1) "T")
						(concatenate 'string 
						  "(tree " 
						  (symbol-name fieldname) 
						  ") "  )
					      (concatenate 'string 
						"(at " 
						(cond ((equal (symbol-name z) "S1") 
						       "squirrel ") 
						      ((equal (symbol-name z) 
							      "N1") "nut ") 
						      (t "something ")) 
						(symbol-name fieldname) ") "  )))
					  y
					  ))
				objects)
			)
		      ) (rest mapdesc))))
		  (field-desc 
		   (reduce 
		    (lambda (y z) 
		      (concatenate 'string y z)) 
		    (mapcar (lambda (x) (concatenate 'string 
					  "(field " 
					  (symbol-name x) 
					  ") ")) 
			    fields)))
		  
		  (adjacent-desc 
		   (reduce 
		    (lambda (y z) 
		      (concatenate 'string y z)) 
		   (determine-adjacent-fields fields)))
		  )
	     (concatenate 
		 'string 
	       "(UCPOP::define (UCPOP::problem ucpop::get-nut) :domain 'ucpop::squirrels :inits ( "
	       field-desc adjacent-desc squirreldesc field-objects ") :goal " gpdesc ")"
	       ) 
	     )
	   ))
  #'(lambda (output)
      (if start 	
	  (progn (print "----")
		 (print output)
		 (print "----")
		 (in-package "UCPOP")
		 (print (output-to-description output))
		 (eval (read-from-string (output-to-description output)))
		 
     (load "operators.lisp")
		 
     (setf ucpop::*search-limit* 1000000)
     (setf plan (ucpop::bf-control 'ucpop::get-nut))	   
     (print plan)
     (setf plan-actions (get-plan plan))
     (setq plan*actions plan-actions)
     
     (setq action (execute-squirrel-action))
     (print (read-from-string action))
     (setf start NIL)
     (read-from-string action)
     )	
	(progn  
	  (setq action (execute-squirrel-action))
	  (print (read-from-string action))
	  (read-from-string action))
    ))))



