(in-package :cl-user)

(defun aterm-to-sexp (aterm)
   (let ((type (ecase (#"getType" aterm)
		(#.(get-java-field 'aterm "APPL") :appl)
		(#.(get-java-field 'aterm "REAL")  :real)
		(#.(get-java-field 'aterm "INT") :int)
		(#.(get-java-field 'aterm "BLOB") :blob)
		(#.(get-java-field 'aterm "LIST") :list)
		(#.(get-java-field 'aterm "PLACEHOLDER") :placeholder))))
    (flet ((to-keyword-maybe (s)
	     (or (cdr (assoc s `(("sub" . :subclass-of) ("subClassOf" . :subclass-of) ("and" . :and) ("card" . :cardinality) ("max" . :maxcardinality) ("equivalentClasses" :equivalent-classes)
				 ("min" . :mincardinality) ("restriction" . :restriction) ("or" . :or)
				 ("some" . :some-values-from) ("all" . :all-values-from)  
				 ("value" . :hasvalue) ("literal" . :literal) ("not" . :not) ("inv" :inv) ("same" :same) ("_TOP_" .,!owl:Thing)
				 ) :test 'equal))
		 (make-uri s))))
      (ecase type
	((:appl)
	 (if (> (#"getLength" (#"getArguments" aterm)) 0)
	     (let* ((head (to-keyword-maybe (#"getName" aterm)))
		    (rest (if (eq head :literal)
			      (mapcar #"toString" (list-to-list (#"getArguments" aterm)))
			      (loop for arg in (list-to-list (#"getArguments" aterm))
				 collect (funcall 'aterm-to-sexp arg)))))
	       (cond			;((member head '(:and))
					; (apply 'append (list head) rest))
		 ((and (eq head :not) (eq (car rest) !owl:Thing)) !owl:Nothing)
		 (t (cons head rest))
		 ))
	     (to-keyword-maybe (#"getName" aterm))))
	(:int (#"getInt" aterm))
	(:real (#"getReal" aterm))
	(:list
	 (loop for term in (list-to-list aterm)
	    collect  (funcall 'aterm-to-sexp term))
	 )))))

;; FIXME not adequately tested.
(defun aterm-sexp-to-class-expression (exp)
  (cond ((uri-p exp) exp)
	((consp exp) 
	 (case (car exp)
	   (:literal `(literal ,(first (rest exp)) ,@(if (third (rest exp)) (list (make-uri (third (rest exp)))) nil)))
	   (:and `(intersection-of ,(aterm-sexp-to-class-expression (first (cadr exp)))
				   ,(aterm-sexp-to-class-expression (second (cadr exp)))))
	   (:not `(complement-of ,(aterm-sexp-to-class-expression (cadr exp))))
	   (:or `(union-of ,(aterm-sexp-to-class-expression (first (cadr exp)))
			   ,(aterm-sexp-to-class-expression (second (cadr exp)))))
	   (:some-values-from
	    (if (and (consp (third exp)) (eq (car (third exp)) :hasvalue))
		`(restriction ,(second exp) (has-value ,(aterm-sexp-to-class-expression (second (third exp)))))
		`(restriction ,(second exp) (some-values-from ,(aterm-sexp-to-class-expression (third exp))))))
	   (:all-values-from  `(restriction ,(second exp) (all-values-from ,(aterm-sexp-to-class-expression  (third exp)))))
	   (:mincardinality `(restriction ,(second exp) (min-cardinality ,(third exp))))
	   (:maxcardinality `(restriction ,(second exp) (max-cardinality ,(third exp))))
	   (otherwise exp)))
	(t exp)))



;(with-ontology foo () ((class !a :partial) (class !b :partial)) (aterm-sexp-to-class-expression (aterm-to-sexp (to-concept (union-OF !ex:a !ex:b) foo))))


(defun sexp-to-aterm (sexp) (error "can't yet"))
; ~/Desktop/pellet-svn/trunk/src/org/mindswap/pellet/tbox/impl/TBoxImpl.java
;(aterm-to-sexp (#"parse" (#"getFactory" 'atermutils)  "[sub(not(a),and(or(b,or(c,not(y))),or(b,or(c,not(x))))),sub(not(y),and(or(not(b),x),or(x,not(a)))),sub(c,or(x,y))]"))
;" src/org/mindswap/pellet/tbox/impl/TBoxImpl.java"

(defun simplify-aterm-sexp (sexp)
  (if (atom sexp) 
      sexp
      (if (and (eq (car sexp) :and) (some (lambda(e) (and (listp e) (eq (car e) :and))) (cdr sexp)))
	  (let ((res 
		 (simplify-aterm-sexp 
		  `(:and ,@(loop for el1 in (cdr sexp)
			     if (and (listp el1) (eq (car el1) :and))
			     append (mapcar 'simplify-aterm-sexp (cdr el1))
			     else collect (simplify-aterm-sexp el1))))))
	    res)
	  (cond ((eq (car sexp) :literal)
		 (list* :literal 
			(cond ((equal (fourth sexp) "http://www.w3.org/2001/XMLSchema#int")
			       (list (parse-integer (second sexp))))
			      ((equal (fourth sexp) "http://www.w3.org/2001/XMLSchema#double")
			       (list (float (read-from-string (second sexp)))))
			      ((equal (fourth sexp) "http://www.w3.org/2001/XMLSchema#string")
			       (list (second sexp)))
			      (t (list (second sexp) (fourth sexp))))))
		(t (mapcar 'simplify-aterm-sexp sexp))))))



(defun render-aterm (aterm)
  (let ((r (new 'AtermAbstractSyntaxRenderer))
	sw)
    (#"setWriter" 
     r (new 'pellet.output.outputformatter (setq sw (new 'stringwriter)) nil))
    (#"visit" r aterm)
    (#"toString" sw)))