(in-package "KPML")
;;;
;;; File: kpml-agile-interface.lisp
;;; John:Stirling:Oct97
;;;
;;; Contains the necessary KR system KPML interface function
;;; definitions for accessing information written in the CLOS-based
;;; representation scheme developed for the AGILE project.

(defvar *kr-file-extension* "clos")

(defun KB-PACKAGE ()
  (find-package "DM"))

(defun KB-CONCEPT-P (c)
  (with-kb-packaged-vars (c)
    (dm::concept-p c)))

(defun KB-SUPERP (c1 c2)
  (and (not (gethash c1 quiry-operators))
       (with-kb-packaged-vars (c1 c2)
	 (and 
	  (kb-concept-p c1)
	  (kb-concept-p c2)
	  (member c2 (dm::get-concept-superconcepts c1))))))

(defun KB=SUPERP (c1 c2)
  (with-kb-packaged-vars (c1 c2)
    (or (eq c1 c2)
	(kb-superp c1 c2))))
		
(defun KB-ImmediateSubCs (concept)
  (with-kb-packaged-vars (concept)
    (and (kb-concept-p concept)
	 (dm::get-concept-subconcepts concept :direct T))))

(defun KB-ImmediateSuperCs (concept)
  (with-kb-packaged-vars (concept)
    (and (kb-concept-p concept)
	 (dm::get-concept-superconcepts concept :direct T))))

(defun KB-ConceptDisjoint? (c1 c2)
  "True, if C1 and C2 belong to disjoint classes."
  (with-kb-packaged-vars (c1 c2)
    (let ((superc1 (kb-immediatesupercs c1))
	  (superc2 (kb-immediatesupercs c2)))
      (and (equal (length superc1) 1)
	   (equal (length superc2) 1)
	   (equal superc1 superc2)
	   (loop for disj in (dm::get-concept-disjoint-subconcepts 
			      (first superc1))
	       thereis (and (member c1 disj)(member c2 disj)))))))


;;; Straight recognition predicates...

(defun KB-entity? (instance) (dm::instance-p instance))

;;; Following collapse due to the use of concept names and
;;; concepts as one and the same...

(defun KB-GetNamedConcept (concept) concept)
(defun KB-GetNamedRelation (relation) relation)
(defun KB-GetConceptName (concept) concept )

;;; Following is a NoOp in Agile since there is no
;;; classification to be triggered, etc.

(defun KB-INITIALIZATIONS () nil)

;;; Is this used? I don't think so...
#+ignore(defun relative-subconcepts (concept list-of-concepts) 
	  "Return subconcepts of CONCEPT which are not subconcepts of any of
   LIST-OF-CONCEPTS."
  )

;;; For display...

(defun KB-GENERATE-SOURCE-DEFINITION (object)
  "Call this to display definitions from the KPML window interface"
  "source not known")
	 
(defun KB-SYSTEM-DEFINED-NAME-P (concept)
  "If the KR system generates its own internal concepts (e.g., in a classification process) it may allow the user to interrogate this status"
    nil)

;;; KPML3.0
;;; New KR interface function, used in interface to guarantee a printable
;;; name. Should be defined with something sensible for all KRs.

 ;; ----------------------------------------------------------------------
 ;; 3.2.25
 ;;  following Agile DM interface function made more robust... 
 ;; ----------------------------------------------------------------------

(defun MAKE-PRINTABLE-CONCEPT-NAME (concept)
  (if (symbolp concept)
      concept           ;; 3.2.25
    (format nil
	    "~A: ~A"
	    (type-of concept)
	    (if (dm::slot-filled-p concept 'dm::uid) 
		(dm::get-instance-slot-value concept 'dm::Uid)
	      :no-id))))




