;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: vocabulary.lsp
;;;;    System: FIRE
;;;;   Version: 1.0
;;;;    Author: Ken Forbus
;;;;   Created: December 27, 2000 13:55:43
;;;;   Purpose: Provides SME interface to KB for vocabulary purposes 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Monday, May 31, 2004 at 15:28:35 by Kenneth Forbus
;;;; ---------------------------------------------------------------------------

(in-package :fire)

;;; SME draws its predicate information from a vocabulary object.
;;; FIRE uses its KB as its vocabulary, so that predicate information
;;; can be shared across all reasoners that are using that KB within an image.
;;; We use the structural cache in the KB as the vocabulary, with sc-entries serving
;;; as predicates.  This file defines the accessors that SME needs for these purposes
;;;
;;; While the predicate definitions can be shared across reasoners, because
;;; the KB is the same, what is considered ubiquitious may vary from reasoner
;;; to reasoner.  So lists of ubiquitious predicates need to be maintained
;;; on a per-source basis.  Similarly, some NotForAnalogyPredicate distinctions
;;; may be on a per-task basis, so this information still needs to be cached with
;;; the source.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Retrieval

(defmethod sme::find-predicate ((predicate-name t) (vocab analogy-source)
                                &key (create? t))
  ;; The create? keyword was for the old incremental system, and
  ;; is only left in for backward compatibility.  It will go away
  ;; as soon as is feasible.  
  (declare (ignore create?)) 
  (with-kb (kb vocab)
    (let ((entry (find-sc-entry predicate-name *kb*)))
      ;; ***** Add error checking?
      entry)))
    
;; ********** An interesting question: With Lambda and Kappa, should we
;; ********** be checking for alphabetic variants?  Might have to, given the
;; ********** way dbex does retrievals sometimes.  

(defmethod sme::find-attribute ((predicate-name t) (vocab analogy-source))
  (with-kb (kb vocab)
    (let ((entry (find-sc-entry predicate-name *kb*)))
      ;; ***** Add error checking?
      entry)))

(defmethod sme::find-attribute ((predicate-name symbol) (vocab analogy-source))
  (with-kb (kb vocab)
    (let ((entry (find-sc-entry predicate-name *kb*)))
      ;; ***** Add error checking?
      entry)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Accessors

(defmethod sme::predicate-type ((pred sc-entry) (vocab analogy-source))
  (cond ((sc-predicate? pred) (sc-type pred))
        ((sc-collection? pred) :attribute)
        (t (error "~A not usable as a predicate (predicate-type)." pred))))

(defmethod sme::pred-type ((pred sc-entry))
  (cond ((sc-predicate? pred) (sc-type pred))
        ((sc-collection? pred) :attribute)
        (t (error "~A not usable as a predicate (pred-type)." pred))))

(defmethod sme::arguments ((pred sc-entry))
  (cond ((sc-predicate? pred)
         (let ((details (sc-details pred)))
           (cond ((sc-n-ary? details) nil)
                 ((integerp (sc-arity details))
                  (cond ((< (sc-arity details) 8)
                         (ecase (sc-arity details)
                           (0 '())
                           (1 '(0))
                           (2 '(0 1))
                           (3 '(0 1 2))
                           (4 '(0 1 2 3))
                           (5 '(0 1 2 3 4))
                           (6 '(0 1 2 3 4 5))
                           (7 '(0 1 2 3 4 5 6))))
                        (t (make-integer-arg-list (sc-arity details)))))
                 (t (error "In arguments: Arity not integer: ~A for ~A."
                      (sc-arity details) pred)))))
        ((sc-collection? pred) '(0))
        (t (error "Arguments: ~A not usable as a predicate." pred))))

(defun make-integer-arg-list (n)
  (let ((result nil))
    (dotimes (i n (nreverse result))
      (push i result))))

(defmethod sme::commutative? ((pred sc-entry))
  (cond ((sc-predicate? pred)
         (sc-commutative? (sc-details pred)))
        ((sc-collection? pred) ;; i.e., an attribute in SME's terms
         nil)
        (t (error "~A not usable as predicate (commutative?)." pred))))

(defmethod sme::n-ary? ((pred sc-entry))
  (cond ((sc-predicate? pred)
         (sc-n-ary? (sc-details pred)))
        ((sc-collection? pred) nil)
        (t (error "~A not usable as predicate (n-ary?)." pred))))

(defmethod sme::lisp-form ((sme-thing sc-entry)) (sc-item sme-thing))

(defmethod sme:user-form ((sme-thing sc-entry)) (sc-item sme-thing))

(defmethod sme::id ((sme-thing sc-entry)) (sc-id sme-thing))

(defmethod sme::ubiquitous-predicate? ((pred sc-entry))
  ;; sc-entries are KB-level entities, whereas the distinction of whether
  ;; or not something is ubiquitous resides with the analogy source in
  ;; a specific reasoner.  Hence we must rely on context to help us out.
  ;; ASK binds *reasoner*, so this should be okay.
  (member (sc-id pred) (ubiquitous-predicates 
                        (analogy-source-of *reasoner*))))

(defmethod sme::parents ((pred sc-entry)) nil)
;; We don't want to do minimal ascension by default.

(defmethod sme::function? ((object sc-entry))
  (if (sc-function? object) t nil))

(defmethod sme::predicate? ((object sc-entry))
  (or (sc-predicate? object)
      (sc-collection? object)))

(defmethod sme::entity? ((object sc-entry)) 
  ;; Is this correct?  I added this but I feel I may be missing something.
  ;; (JMU 1/20/2004)
  (and (not (sc-predicate? object))
       (not (sc-collection? object))))

(defmethod sme::name  ((object sc-entry)) (sc-item object))
    
(defmethod sme::attribute? ((pred sc-entry)) (sc-collection? pred))
;; ****** At some point we need to decide if we want to squeeze cyc's old
;; ****** attribute system into this.  They are getting rid of it, so that isn't
;; ****** exactly high priority.

(defmethod sme::roots ((object sc-entry)) (list object))

(defmethod sme::role-relation? (pred (vocab analogy-source))
  (let* ((reasoner (reasoner vocab))
         (kb (and reasoner (kb reasoner))))
    (when (open-kb? kb)
      (instance-of? pred 'd::Role kb))))

;;;; Some SME ancient holdovers that might ought to be cleaned out sometime.
(defmethod sme::symmetric? ((pred sc-entry)) nil) ;; We don't use this in SME right now
(defmethod sme::script? ((pred sc-entry)) nil) ;; ditto
(defmethod sme::set? ((pred sc-entry)) nil)
(defmethod sme::group? ((pred sc-entry)) nil)
;; These are included in SME predicates for systems that are more stand-alone.
;; FIRE-based systems can use the general KB facilities for these purposes.
(defmethod sme::pidgin-description-string ((pred sc-entry)) "")
(defmethod sme::doc-string ((pred sc-entry)) "")
(defmethod sme::notes ((pred sc-entry)) "")



;;;; ---------------------------------------------------------------------------
;;; END OF CODE