(in-package "COMMUNICATION")

(defvar cv:*stream-output* (make-string-output-stream))
(defvar cv:*theory* nil)

;;; KQML performatives


;; EVALUATE

(defmacro evaluate (&key (language 'lisp) ontology (reply-with nil) content (sender *myname*) receiver)
  `(let ((cv::*theory* (or ',ontology cv::*theory*)))
    (if (equal ,receiver *myname*)
	(cond
	  ((equal 'lisp ',language) 
	   (send-answer ,sender (answer (multiple-value-list (ignore-errors ,content))
					'lisp
					',ontology
					',reply-with
					,sender
					,receiver)))
	  ((equal 'kif ',language)
	   (send-answer ,sender (answer (multiple-value-list
					    (ignore-errors
					     (eval (pqkif::intern-object  ',content 'pqkif))))
					'kif
					',ontology
					',reply-with
					,sender
					,receiver)))
	  (t
	   (send-answer ,sender (answer (list nil "we do not speak the same language")
					',language
					',ontology
					',reply-with
					,sender
					,receiver))))
	(Lisp-KSendString
	 (kqml-performance "evaluate"
			   ',content
			   ',language
			   ',ontology
			   ',reply-with
			   ,sender
			   ,receiver)
	 ,receiver))))


	  

;; ACHIEVE


(defmacro achieve (&key (language 'lisp) ontology (reply-with nil) content (sender *myname*) receiver)
  `(let ((*theory* (or ',ontology *theory*)))
    (print *theory*)
    (if (equal ,receiver *myname*)
	(if (equal 'lisp ',language)
	    (send-answer ,sender (answer (heaviside (multiple-value-list (ignore-errors ,content)))
					 'lisp
					 ',ontology
					 ',reply-with
					 ,sender
					 ,receiver))
	    (send-answer ,sender (answer (list nil "Lisp should be the language")
					 ',language
					 ',ontology
					 ',reply-with
					 ,sender
					 ,receiver)))
	(progn
	  (Lisp-KSendString
	   (kqml-performance "achieve"
			     ',content
			     ',language
			     ',ontology
			     ',reply-with
			     ,sender
			     ,receiver)
	   ,receiver)))))

	
;;;;
(defun send-answer (who l)
  (if (equal who *myname*)
      (mapcar #'(lambda (x) (format t "~a~%" x)) l)
      (progn
	(Lisp-KSendString (format nil "~a" (length l)) who)
	(mapcar #'(lambda (x) (Lisp-KSendString x who)) l))))

;;;;
(defun answer (evaluation-list language ontology reply sender receiver)
  (let ((message (get-output-stream-string *stream-output*))
	(response (list (if (typep (cadr evaluation-list) 'error)
			    (kqml-performance "error" (format nil "\"~a\"" (cadr evaluation-list))
					      language ontology reply sender receiver)
			    (kqml-performance "reply" (format nil "~a" (car evaluation-list))
					      language ontology reply sender receiver)))))
    (if (or (equal message "") (not message))
	response
	(cons
	  (kqml-performance "reply" (format nil "\"~a\"" message) language ontology reply sender receiver)
	  response))))
	
;;;;
(defun kqml-performance (perfor content language ontology reply sender receiver)
  (if reply
      (if ontology 
	  (format nil "(~a :content ~a :language ~a :ontology ~a :in-reply-to ~a :sender ~s :receiver ~s)"
		  perfor content language ontology reply sender receiver)
	  (format nil "(~a :content ~a :language ~a :in-reply-to ~a :sender ~s :receiver ~s)"
		  perfor content language reply sender receiver))
      (if ontology
	  (format nil "(~a :content ~a :language ~a :ontology ~a :sender ~s :receiver ~s)"
		  perfor content language ontology sender receiver)
	  (format nil "(~a :content ~a :language ~a :sender ~s :receiver ~s)"
		  perfor content language sender receiver))))


;;;;;
(defun heaviside(l)
  (if (typep (cadr l) 'error)
      l
      '(t)))