;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: sme-accessors.lsp
;;;;    System: 
;;;;    Author: Ken Forbus
;;;;   Created: February 5, 2004 16:09:44
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Saturday, February 21, 2004 at 20:41:02 by Kenneth Forbus
;;;; ---------------------------------------------------------------------------

(in-package :fire)

;;;; Accessors for SME

;;; **** Implement handlers for required/excluded constraints
;;; **** Implement handlers for inspecting SME parameters
;;; **** (Somewhere) Implement methods for reasoner-level control of SME parameters

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Properties of cases

(defun register-case-handlers (source reasoner)
  ;; (numberOfCaseEntities ?case ?n)
  (register-simple-handler data::numberOfCaseEntities
                           ;; Test
                           number-of-case-entities-test
                           (:known :known))
  (register-simple-handler data::numberOfCaseEntities
                           ;; Test
                           number-of-case-entities-find
                           (:known :variable))
  ;; (numberOfCaseFacts ?case ?n)
  (register-simple-handler data::numberOfCaseFacts
                           ;; Test
                           number-of-case-facts-test
                           (:known :known))
  (register-simple-handler data::numberOfCaseFacts
                           ;; Test
                           number-of-case-facts-find
                           (:known :variable))
  ;; (caseMentionsPredicate ?case ?predicate)
  (register-simple-handler data::caseMentionsPredicate
                           ;; Test
                           case-mentions-predicate-test
                           (:known :known))
  (register-simple-handler data::caseMentionsPredicate
                           ;; Test
                           case-mentions-predicate-find
                           (:known :variable))
  ;; (caseMentionsEntity ?case ?entity)
  (register-simple-handler data::caseMentionsEntity
                           ;; Test
                           case-mentions-entity-test
                           (:known :known))
  (register-simple-handler data::caseMentionsEntity
                           ;; Test
                           case-mentions-entity-find
                           (:known :variable))
  source)

;; (numberOfCaseEntities ?case ?n)

(defsource-handler
    number-of-case-entities-test (case n)
  (when (numberp n)
    (let ((real-case (get-dgroup case source)))
      (when (and (sme::dgroup? real-case)
                 (= (length (compute-fire-entities-for-dgroup real-case))
                    n))
        (generate-cached-single-ask-response
         nil
         (make-dgroup-timeclock-antecedents real-case))))))

(defsource-handler
    number-of-case-entities-find (case)
  (let ((real-case (get-dgroup case source)))
    (when (sme::dgroup? real-case)
      (generate-cached-single-ask-response 
       (list (cons (third query)
                   (length (compute-fire-entities-for-dgroup real-case))))
       (make-dgroup-timeclock-antecedents real-case)))))

;; (numberOfCaseFacts ?case ?n)

(defsource-handler
    number-of-case-facts-test (case n)
  (when (numberp n)
    (let ((real-case (get-dgroup case source)))
      (when (and (sme::dgroup? real-case)
                 (= (sme::expression-count real-case)
                    n))
        (generate-cached-single-ask-response
         nil
         (make-dgroup-timeclock-antecedents real-case))))))

(defsource-handler
    number-of-case-facts-find (case)
  (let ((real-case (get-dgroup case source)))
    (when (sme::dgroup? real-case)
      (generate-cached-single-ask-response 
       (list (cons (third query)
                   (sme::expression-count real-case)))
       (make-dgroup-timeclock-antecedents real-case)))))

;; (caseMentionsPredicate ?case ?predicate)

;; We take this to mean mentioning the predicate either
;; by using it as a predicate, or as being mentioned in
;; some other relationship (so that, for instance, we
;; properly detect higher-order usages of a predicate).

(defsource-handler
    case-mentions-predicate-test (case predicate)
  (when (predicate? predicate) 
    (let ((real-case (get-dgroup case source)))
      (when (and (sme::dgroup? real-case)
                 (dgroup-mentions-fire-predicate? predicate real-case))
        (generate-cached-single-ask-response 
         nil
         (make-dgroup-timeclock-antecedents real-case))))))

(defsource-handler
    case-mentions-predicate-find (case)
  (let ((real-case (get-dgroup case source)))
    (when (sme::dgroup? real-case)
      (generate-cached-multiple-ask-responses
       (mapcar #'(lambda (entity)
                   (list (cons (third query) entity)))
         (compute-fire-predicates-for-dgroup real-case))
       (make-dgroup-timeclock-antecedents real-case)))))


;; (caseMentionsEntity ?case ?entity)

(defsource-handler
    case-mentions-entity-test (case entity)
  (let ((real-case (get-dgroup case source)))
    (when (and (sme::dgroup? real-case)
               (member entity
                       (compute-fire-entities-for-dgroup
                        real-case)))
      (generate-cached-single-ask-response
       nil (make-dgroup-timeclock-antecedents real-case)))))

(defsource-handler
    case-mentions-entity-find (case)
  (let ((real-case (get-dgroup case source)))
    (when (sme::dgroup? real-case)
      (generate-cached-multiple-ask-responses
       (mapcar #'(lambda (entity)
                   (list (cons (third query) entity)))
         (compute-fire-entities-for-dgroup real-case))
       (make-dgroup-timeclock-antecedents real-case)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Properties of matches

(defun register-matcher-handlers (source reasoner)
  ;; N.B. run-basic-sme is defined in analogy-source.lsp
  (register-ask-source reasoner (if (mixed-case?) 
                                  'data::matchBetween
                                  'data::match-between)
                       source
                       'run-basic-sme '(:known :known :known :variable)
                       '(:input-only :input-only :input-only :produces)
                       :medium)
  (register-ask-source reasoner 
                       (if (mixed-case?) 
                         'data::seekingMatchBetween
                         'data::seeking-match-between)
                       source
                       'run-basic-sme '(:known :known :known :variable)
                       '(:input-only :input-only :input-only :produces)
                       :medium)
  (register-ask-source reasoner 
                       (if (mixed-case?) 
                         'data::filteredMatchBetween
                         'data::filtered-match-between)
                       source
                       'run-basic-sme '(:known :known :known :variable)
                       '(:input-only :input-only :input-only :produces)
                       :medium)
  (register-ask-source reasoner 
                       (if (mixed-case?) 
                         'data::strongFilteredMatchBetween
                         'data::strong-filtered-match-between)
                       source
                       'run-basic-sme '(:known :known :known :variable)
                       '(:input-only :input-only :input-only :produces)
                       :medium)
  ;;; Inspecting properties
  ;; (mappingOf ?mapping ?match)
  ;; Cases: both arguments fixed, return t or nil
  ;;  ?mapping variable, ?match fixed -- return all mappings
  ;;  ?mapping constant, ?match variable -- return the SME it came from
  ;;  both variable: Do second case for each matcher.
  (register-simple-handler data::mappingOf 
                           mapping-of-test 
                           (:known :known))
  (register-simple-handler data::mappingOf
                           mapping-of-find-mappings
                           (:variable :known))
  (register-simple-handler data::mappingOf
                           mapping-of-find-sme
                           (:known :variable))
  ;; (bestMapping ?match ?mapping)
  ;; Ignore bestMapping case where both are unknown, unlikely to ever
  ;; be wanted.
  (register-simple-handler data::bestMapping
                           ;; ?match known, find ?mapping
                           best-mapping-find-mapping
                           (:known :variable))
  (register-simple-handler data::bestMapping
                           ;; ?match unknown, find using ?mapping
                           best-mapping-find-match
                           (:variable :known))
  (register-simple-handler data::bestMapping
                           best-mapping-test
                           (:known :known))
  ;; (numberOfMappings ?match ?n)
  ;; Ignore all unbound case, unlikely to be what someone wants
  (register-simple-handler data::numberOfMappings
                           ;; ?match known, find ?n
                           number-of-mappings-find-n
                           (:known :variable))
  (register-simple-handler data::numberOfMappings
                           ;; Find ?match using ?n (for debugging)
                           number-of-mappings-find-match
                           (:variable :known))
  ;; (correspondenceOf ?correspondence ?match)
  ;; Again, all variables will just be ignored.  Better to fail fast
  ;; than to deluge someone with a massive number of results that they
  ;; didn't mean.
  (register-simple-handler data::correspondenceOf
                           ;; ?correspondence known, find ?match
                           correspondence-of-find-match
                           (:known :variable))
  (register-simple-handler data::correspondenceOf
                           ;; ?match known, ?correspondence not -- gatherer
                           correspondence-of-find-correspondences
                           (:variable :known))
;; (excludedCorrespondenceOf ?match ?base-item ?target-item)

;; (requiredCorrespondenceOf ?match ?base-item ?target-item)

;; (requiredBaseCorrespondenceOf ?match ?base-item)

;; (requiredTargetCorrespondenceOf ?match ?target-item)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (mappingOf ?mapping ?match)
;; Cases: both arguments fixed, return t or nil
;;  ?mapping variable, ?match fixed -- return all mappings
;;  ?mapping constant, ?match variable -- return the SME it came from
;;  both variable: Do second case for each matcher.

(defsource-handler
    mapping-of-test (mapping match)
  ;; Is mapping one of the mappings in match?
  (let ((real-matcher (sme-referent match source))
        (real-mapping (sme-referent mapping source)))
    (when (and (sme::sme? real-matcher)
               (sme::mapping? real-mapping)
               (eq real-matcher (sme::sme real-mapping)))
      (generate-cached-single-ask-response
       nil (make-sme-relevance-antecedents real-matcher)))))

(defsource-handler
    mapping-of-find-mappings (match)
  (let ((real-matcher (sme-referent match source)))
    (when (sme::sme? real-matcher)
      (let ((mapping-terms (mapcar 'make-mapping-reference 
                             (sme::mappings real-matcher))))
        (when mapping-terms
          (generate-cached-multiple-ask-responses
           (mapcar #'(lambda (term)
                       (list (cons (cadr query) term)))
             mapping-terms)
           (make-sme-timeclock-antecedents real-matcher)))))))

(defsource-handler
    mapping-of-find-sme (mapping)
  (let ((real-mapping (sme-referent mapping source)))
    (cond ((sme::mapping? real-mapping)
           (let ((sme-term (make-sme-reference (sme::sme real-mapping))))
             (generate-cached-single-ask-response 
              (list (cons (third query) sme-term))
              (make-sme-relevance-antecedents real-mapping)))))))

        
;;;; (bestMapping ?match ?mapping)

(defsource-handler
    best-mapping-test (match mapping)
  (let ((real-match (sme-referent match source))
        (real-mapping (sme-referent mapping source)))
    (when (and (sme::sme? real-match)
               (sme::mapping? real-mapping)
               (sme::mappings real-match)
               (eq real-mapping
                   (compute-largest-mapping
                    (sme::mappings real-match))))
      (generate-cached-single-ask-response
       nil (make-sme-timeclock-antecedents real-match)))))

(defsource-handler
    best-mapping-find-mapping (match)
  (let ((real-match (sme-referent match source)))
    (when (sme::sme? real-match)
      (let ((mappings (sme::mappings real-match)))
        (when mappings
          (generate-cached-single-ask-response
           (list (cons (third query)
                       (generate-analogy-term 
                        (compute-largest-mapping mappings))))
           (make-sme-timeclock-antecedents real-match)))))))

(defsource-handler
    best-mapping-find-match (mapping)
  (let ((real-mapping (sme-referent mapping source)))
    (when (sme::mapping? real-mapping)
      (generate-cached-single-ask-response
       (list (cons (cadr query)
                   (generate-analogy-term
                    (sme::sme real-mapping))))
       (make-sme-timeclock-antecedents real-mapping)))))
             

;;;; (numberOfMappings ?match ?n)

(defsource-handler
    number-of-mappings-find-n (match)
  (let ((real-match (sme-referent match source)))
    (when (sme::sme? real-match)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (length (sme::mappings real-match))))
       (make-sme-timeclock-antecedents real-match)))))

(defsource-handler ;; Not cached in LTRE -- would have to hack antes seperately
 number-of-mappings-find-match (n)
 (when (integerp n)
   (let ((winners (remove-if-not #'(lambda (sme)
                                     (= (length (sme::mappings sme)) n))
                                 (smes source))))
     (when winners
       (generate-multiple-ask-responses
        (mapcar #'(lambda (sme)
                    (list (cons (cadr query)
                                (make-sme-reference sme))))
          winners))))))

;; (correspondenceOf ?correspondence ?match)

(defsource-handler
    correspondence-of-find-match (correspondence)
  (let ((real-mh (sme-referent correspondence source)))
    (when (sme::mh? real-mh)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (make-sme-reference
                    (sme::sme real-mh))))
       (make-sme-relevance-antecedents (sme::sme real-mh))))))

(defsource-handler
    correspondence-of-find-correspondences (match)
  (let ((real-sme (sme-referent match source)))
    (when (sme::sme? real-sme)
      (generate-cached-multiple-ask-responses
       (mapcar #'(lambda (mh)
                   (list (cons (cadr query) 
                               (generate-analogy-term mh))))
         (sme::mhs real-sme))
       (make-sme-relevance-antecedents real-sme)))))

;; ****** Still to be implemented:

;; (excludedCorrespondenceOf ?match ?base-item ?target-item)

;; (requiredCorrespondenceOf ?match ?base-item ?target-item)

;; (requiredBaseCorrespondenceOf ?match ?base-item)

;; (requiredTargetCorrespondenceOf ?match ?target-item)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Properties of mappings

(defun register-mapping-handlers (source reasoner)
  ;; (hasCorrespondence ?mapping ?correspondence)
  (register-simple-handler data::hasCorrespondence
                           ;; Test
                           has-correspondence-test
                           (:known :known))
  (register-simple-handler data::hasCorrespondence
                           ;; Find correspondences
                           has-correspondence-find
                           (:known :variable))
  ;; (entitySimilarityOf ?mapping ?mh)
  (register-simple-handler data::entitySimilarityOf
                           ;; Test
                           entity-similarity-of-test
                           (:known :known))
  (register-simple-handler data::entitySimilarityOf
                           ;; Find entity mhs
                           entity-similarity-of-find
                           (:known :variable))
  ;; (rootSimilarityOf ?mapping ?mh)
  (register-simple-handler data::rootSimilarityOf
                           ;; Test
                           root-similarity-of-test
                           (:known :known))
  (register-simple-handler data::rootSimilarityOf
                           ;; Find entity mhs
                           root-similarity-of-find
                           (:known :variable))   
  ;; (numberOfCorrespondences ?mapping ?n)
  (register-simple-handler data::numberOfCorrespondences
                           ;; Test
                           number-of-correspondences-test
                           (:known :known))
  (register-simple-handler data::numberOfCorrespondences
                           ;; Find
                           number-of-correspondences-find
                           (:known :variable))
  ;; (numberOfCandidateInferences ?mapping ?n)
  (register-simple-handler data::numberOfCandidateInferences
                           ;; Test
                           number-of-candidate-inferences-test
                           (:known :known))
  (register-simple-handler data::numberOfCandidateInferences
                           ;; Find
                           number-of-candidate-inferences-find
                           (:known :variable))
  ;; (structuralEvaluationScoreOf ?thing ?n)
  (register-simple-handler data::structuralEvaluationScoreOf
                           structural-evaluation-score-of-test
                           (:known :known))
    (register-simple-handler data::structuralEvaluationScoreOf
                           structural-evaluation-score-of-find
                           (:known :variable))
  source)

;; (hasCorrespondence ?mapping ?correspondence)
(defsource-handler
    has-correspondence-test (thing mh)
  (let ((real-thing (sme-referent thing source))
        (real-mh (sme-referent mh source)))
    (when (and (or (sme::sme? real-thing)
                   (sme::mapping? real-thing)
                   (sme::candidate-inference? real-thing))
               (sme::mh? real-mh)
               (member real-mh (sme::mhs real-thing)))
      (generate-cached-single-ask-response
       nil (make-sme-relevance-antecedents 
            (sme-of real-thing))))))

(defsource-handler
    has-correspondence-find (thing)
  (let ((real-thing (sme-referent thing source)))
    (when (and (or (sme::sme? real-thing)
                   (sme::mapping? real-thing)
                   (sme::candidate-inference? real-thing))
               (sme::mhs real-thing))
      (generate-cached-multiple-ask-responses
       (mapcar #'(lambda (mh)
                   (list (cons (third query) (make-mh-reference mh))))
         (sme::mhs real-thing))
       (make-sme-relevance-antecedents (sme-of real-thing))))))

;; (entitySimilarityOf ?mapping ?mh)

(defsource-handler
    entity-similarity-of-test (thing mh)
  (let ((real-thing (sme-referent thing source))
        (real-mh (sme-referent mh source)))
    (when (and (or (sme::sme? real-thing)
                   (sme::mapping? real-thing)
                   (sme::candidate-inference? real-thing))
               (sme::mh? real-mh)
               (member real-mh (sme::mhs real-thing))
               (sme::entity-mh? real-mh))
      (generate-cached-single-ask-response
       nil (make-sme-relevance-antecedents (sme-of real-thing))))))
 
(defsource-handler 
    entity-similarity-of-find (thing)
  (let ((real-thing (sme-referent thing source)))
    (when (and (or (sme::sme? real-thing)
                   (sme::mapping? real-thing)
                   (sme::candidate-inference? real-thing)))
      (let ((results nil))
        (dolist (mh (sme::mhs real-thing))
          (if (sme::entity-mh? mh) (push mh results)))
        (when results
          (generate-cached-multiple-ask-responses
           (mapcar #'(lambda (mh)
                       (list (cons (third query) (make-mh-reference mh))))
             results)
           (make-sme-relevance-antecedents (sme-of real-thing))))))))

;; (rootSimilarityOf ?mapping ?mh)

(defsource-handler
    root-similarity-of-test (thing mh)
  (let ((real-thing (sme-referent thing source))
        (real-mh (sme-referent mh source)))
    (when (and (or (sme::sme? real-thing)
                   (sme::mapping? real-thing)
                   (sme::candidate-inference? real-thing))
               (sme::mh? real-mh)
               (member real-mh (sme::mhs real-thing))
               (sme::root-mh? real-mh))
      (generate-cached-single-ask-response
       nil (make-sme-relevance-antecedents (sme-of real-thing))))))

(defsource-handler 
    root-similarity-of-find (thing)
  (let ((real-thing (sme-referent thing source)))
    (when (and (or (sme::sme? real-thing)
                   (sme::mapping? real-thing)
                   (sme::candidate-inference? real-thing)))
      (let ((results nil))
        (dolist (mh (sme::mhs real-thing))
          (if (sme::root-mh? mh) (push mh results)))
        (when results
          (generate-cached-multiple-ask-responses
           (mapcar #'(lambda (mh)
                       (list (cons (third query) (make-mh-reference mh))))
             results)
           (make-sme-relevance-antecedents (sme-of real-thing))))))))
  
;; (numberOfCorrespondences ?mapping ?n)

(defsource-handler
    number-of-correspondences-test (thing n)
  (when (numberp n)
    (let ((real-thing (sme-referent thing source)))
      (when (and (or (sme::sme? real-thing)
                     (sme::mapping? real-thing)
                     (sme::candidate-inference? real-thing))
                 (= (length (sme::mhs real-thing)) n))
        (generate-cached-single-ask-response
         nil (make-sme-timeclock-antecedents (sme-of real-thing)))))))

(defsource-handler 
    number-of-correspondences-find (thing)
  (let ((real-thing (sme-referent thing source)))
    (when (or (sme::sme? real-thing)
              (sme::mapping? real-thing)
              (sme::candidate-inference? real-thing))
      (generate-cached-single-ask-response
       (list (cons (third query) (length (sme::mhs real-thing))))
       (make-sme-timeclock-antecedents (sme-of real-thing))))))

;; (numberOfCandidateInferences ?mapping ?n)

(defsource-handler
    number-of-candidate-inferences-test (thing n)
  (when (numberp n)
    (let ((real-mapping (sme-referent thing source)))
      (when (and (sme::mapping? real-mapping)
                 (= (length (sme::inferences real-mapping)) n))
        (generate-cached-single-ask-response
         nil (make-sme-timeclock-antecedents (sme-of real-mapping)))))))

(defsource-handler 
    number-of-candidate-inferences-find (thing)
  (let ((real-mapping (sme-referent thing source)))
    (when (sme::mapping? real-mapping)
      (generate-cached-single-ask-response
       (list (cons (third query) (length (sme::inferences real-mapping))))
       (make-sme-timeclock-antecedents (sme-of real-mapping))))))

;; (structuralEvaluationScoreOf ?sme-thing ?score)

(defsource-handler
    structural-evaluation-score-of-test (sme-thing score)
  (when (numberp score)
    (let ((real-thing (sme-referent sme-thing source)))
      (when (and (or (sme::sme? real-thing)
                     (sme::mh? real-thing)
                     (sme::mapping? real-thing))
                 (= (sme::score real-thing) score))
        (generate-cached-single-ask-response
         nil (make-sme-timeclock-antecedents (sme-of real-thing)))))))

(defsource-handler
    structural-evaluation-score-of-find (sme-thing)
  (let ((real-thing (sme-referent sme-thing source)))
    (when (and (or (sme::mh? real-thing)
                   (sme::mapping? real-thing))
               (numberp (sme::score real-thing)))
      (generate-cached-single-ask-response
       (list (cons (third query) (sme::score real-thing)))
       (make-sme-timeclock-antecedents (sme-of real-thing))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Relationships involving correspondences

(defun register-correspondence-handlers (source reasoner)
  ;; (correspondenceBetween ?correspondence ?base-prop ?target-prop)
  (register-simple-handler data::correspondenceBetween
                           ;; Extractor: ?correspondence known, nothing else
                           correspondence-between-find-parts
                           (:known :variable :variable))
  (register-simple-handler data::correspondenceBetween
                           ;; Test: All known
                           correspondence-between-test
                           (:known :known :known))
  (register-simple-handler data::correspondenceBetween
                           ;; Fill in base
                           correspondence-between-base-fillin
                           (:known :variable :known))
  (register-simple-handler data::correspondenceBetween
                           ;; Fill in target
                           correspondence-between-target-fillin
                           (:known :known :variable))
  ;; (correspondenceBaseItem ?correspondence ?base-prop)
  (register-simple-handler data::correspondenceBaseItem
                           ;; Extractor
                           correspondence-base-item-find-base
                           (:known :variable))
  (register-simple-handler data::correspondenceBaseItem
                           ;; Test
                           correspondence-base-item-test
                           (:known :known))
  ;; (correspondenceTargetItem ?correspondence ?target-prop)
  (register-simple-handler data::correspondenceTargetItem
                           ;; Extractor
                           correspondence-target-item-find-target
                           (:known :variable))
  (register-simple-handler data::correspondenceTargetItem
                           ;; Test
                           correspondence-target-item-test
                           (:known :known))
  ;; (correspondenceForBaseItem ?sme ?base-prop ?correspondence)
  (register-simple-handler data::correspondenceForBaseItem
                           ;; Test
                           correspondence-for-base-item-test
                           (:known :known :known))
  (register-simple-handler data::correspondenceForBaseItem
                           ;; Extract correspondence
                           correspondence-for-base-item-find-correspondence
                           (:known :known :variable))
  (register-simple-handler data::correspondenceForBaseItem
                           ;; Fill in base item
                           correspondence-for-base-item-find-base
                           (:known :variable :known))
  ;; (correspondenceForTargetItem ?sme ?target-prop ?correspondence)
  (register-simple-handler data::correspondenceForTargetItem
                           ;; Test
                           correspondence-for-target-item-test
                           (:known :known :known))
  (register-simple-handler data::correspondenceForTargetItem
                           ;; Extract correspondence
                           correspondence-for-target-item-find-correspondence
                           (:known :known :variable))
  (register-simple-handler data::correspondenceForTargetItem
                           ;; Fill in base item
                           correspondence-for-target-item-find-target
                           (:known :variable :known))
  source)
  

;; (correspondenceBetween ?correspondence ?base-prop ?target-prop)
(defsource-handler 
    correspondence-between-find-parts (correspondence)
  (let ((real-mh (sme-referent correspondence source)))
    (when (sme::mh? real-mh)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (sme->fire-expression
                    (sme::lisp-form (sme::base-item real-mh))))
             (cons (fourth query)
                   (sme->fire-expression
                    (sme::lisp-form (sme::target-item real-mh)))))
       (make-sme-relevance-antecedents (sme-of real-mh))))))

(defsource-handler
    correspondence-between-test (correspondence base-item target-item)
  (let ((real-mh (sme-referent correspondence source)))
    (when (sme::mh? real-mh)
      (if (and (equal (sme->fire-expression
                       (sme::lisp-form (sme::base-item real-mh)))
                      base-item)
               (equal (sme->fire-expression
                       (sme::lisp-form (sme::target-item real-mh)))
                      target-item))
        (generate-cached-single-ask-response
         nil (make-sme-relevance-antecedents (sme-of real-mh)))))))
             
(defsource-handler
      correspondence-between-base-fillin (correspondence target-item)
  (let ((real-mh (sme-referent correspondence source)))
    (when (sme::mh? real-mh)
      (if (equal (sme->fire-expression (sme::lisp-form (sme::target-item real-mh)))
                 target-item)
        (generate-cached-single-ask-response
         (list (cons (third query) 
                     (sme->fire-expression
                      (sme::lisp-form
                       (sme::base-item real-mh)))))
         (make-sme-relevance-antecedents (sme-of real-mh)))))))

(defsource-handler
      correspondence-between-target-fillin (correspondence base-item)
  (let ((real-mh (sme-referent correspondence source)))
    (when (sme::mh? real-mh)
      (if (equal (sme->fire-expression (sme::lisp-form (sme::base-item real-mh)))
                 base-item)
        (generate-cached-single-ask-response
         (list (cons (fourth query) 
                     (sme->fire-expression
                      (sme::lisp-form
                       (sme::target-item real-mh)))))
         (make-sme-relevance-antecedents (sme-of real-mh)))))))

;; (correspondenceBaseItem ?correspondence ?base-prop)

(defsource-handler
    correspondence-base-item-find-base (correspondence)
  (let ((real-mh (sme-referent correspondence source)))
    (when (sme::mh? real-mh)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (sme->fire-expression
                    (sme::lisp-form (sme::base-item real-mh)))))
       (make-sme-relevance-antecedents (sme-of real-mh))))))

(defsource-handler
    correspondence-base-item-test (correspondence base-item)
  (let ((real-mh (sme-referent correspondence source)))
    (when (and (sme::mh? real-mh)
               (equal (sme->fire-expression
                       (sme::lisp-form (sme::base-item real-mh)))
                      base-item))
      (generate-cached-single-ask-response
       nil (make-sme-relevance-antecedents (sme-of real-mh))))))
 
;; (correspondenceTargetItem ?correspondence ?target-prop)

(defsource-handler
    correspondence-target-item-find-target (correspondence)
  (let ((real-mh (sme-referent correspondence source)))
    (when (sme::mh? real-mh)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (sme->fire-expression
                    (sme::lisp-form (sme::target-item real-mh)))))
       (make-sme-relevance-antecedents (sme-of real-mh))))))

(defsource-handler
    correspondence-target-item-test (correspondence target-item)
  (let ((real-mh (sme-referent correspondence source)))
    (when (and (sme::mh? real-mh)
               (equal (sme->fire-expression
                       (sme::lisp-form (sme::target-item real-mh)))
                      target-item))
      (generate-cached-single-ask-response
       nil (make-sme-relevance-antecedents (sme-of real-mh))))))

;; (correspondenceForBaseItem ?sme ?base-prop ?correspondence)

(defsource-handler
    correspondence-for-base-item-test (sme base-item correspondence)
  (let ((real-sme-thing (sme-referent sme source))
        (real-mh (sme-referent correspondence source)))
    (when (and (or (sme::sme? real-sme-thing)
                   (sme::mapping? real-sme-thing))
               (sme::mh? real-mh)
               (member real-mh (sme::mhs real-sme-thing))
               (equal (sme->fire-expression
                       (sme::lisp-form (sme::base-item real-mh)))
                      base-item))
      (generate-cached-single-ask-response
       nil
       (make-sme-relevance-antecedents (sme-of real-mh))))))

(defsource-handler
    correspondence-for-base-item-find-base (sme correspondence)
  (let ((real-sme-thing (sme-referent sme source))
        (real-mh (sme-referent correspondence source)))
    (when (and (or (sme::sme? real-sme-thing)
                   (sme::mapping? real-sme-thing))
               (sme::mh? real-mh)
               (member real-mh (sme::mhs real-sme-thing)))
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (sme->fire-expression
                    (sme::lisp-form
                     (sme::base-item real-mh)))))
       (make-sme-relevance-antecedents (sme-of real-sme-thing))))))

(defsource-handler
    correspondence-for-base-item-find-correspondence (sme base-item)
  (let ((real-sme-thing (sme-referent sme source))
        (results nil))
    (when (or (sme::sme? real-sme-thing)
              (sme::mapping? real-sme-thing))
      ;; If the first argument is an SME, there could be more than one.
      (dolist (mh (sme::mhs real-sme-thing))
        (if (equal (sme->fire-expression (sme::lisp-form (sme::base-item mh)))
                   base-item)
          (push mh results)))
      (when results
        (generate-cached-multiple-ask-responses
         (mapcar #'(lambda (mh)
                     (list (cons (fourth query) (make-mh-reference mh))))
           results)
         (make-sme-relevance-antecedents (sme-of real-sme-thing)))))))
  
;; (correspondenceForTargetItem ?sme ?target-prop ?correspondence)

(defsource-handler
    correspondence-for-target-item-test (sme target-item correspondence)
  (let ((real-sme-thing (sme-referent sme source))
        (real-mh (sme-referent correspondence source)))
    (when (and (or (sme::sme? real-sme-thing)
                   (sme::mapping? real-sme-thing))
               (sme::mh? real-mh)
               (member real-mh (sme::mhs real-sme-thing))
               (equal (sme->fire-expression
                       (sme::lisp-form (sme::target-item real-mh)))
                      target-item))
      (generate-cached-single-ask-response
       nil
       (make-sme-relevance-antecedents (sme-of real-sme-thing))))))

(defsource-handler
    correspondence-for-target-item-find-target (sme correspondence)
  (let ((real-sme-thing (sme-referent sme source))
        (real-mh (sme-referent correspondence source)))
    (when (and (or (sme::sme? real-sme-thing)
                   (sme::mapping? real-sme-thing))
               (sme::mh? real-mh)
               (member real-mh (sme::mhs real-sme-thing)))
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (sme->fire-expression
                    (sme::lisp-form
                     (sme::target-item real-mh)))))
       (make-sme-relevance-antecedents (sme-of real-sme-thing))))))

(defsource-handler
    correspondence-for-target-item-find-correspondence (sme target-item)
  (let ((real-sme-thing (sme-referent sme source))
        (results nil))
    (when (or (sme::sme? real-sme-thing)
              (sme::mapping? real-sme-thing))
      ;; If the first argument is an SME, there could be more than one.
      (dolist (mh (sme::mhs real-sme-thing))
        (if (equal (sme->fire-expression 
                    (sme::lisp-form (sme::target-item mh)))
                   target-item)
          (push mh results)))
      (when results
        (generate-cached-multiple-ask-responses
         (mapcar #'(lambda (mh)
                     (list (cons (fourth query) (make-mh-reference mh))))
           results)
         (make-sme-relevance-antecedents (sme-of real-sme-thing)))))))
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Relationships involving candidate inferences

(defun register-candidate-inference-handlers (source reasoner)
  ;; (candidateInferenceOf ?candidateInference ?mapping)
  (register-simple-handler data::candidateInferenceOf
                           ;; Test
                           candidate-inference-of-test
                           (:known :known))
  (register-simple-handler data::candidateInferenceOf
                           ;; Find mapping
                           candidate-inference-of-find-mapping
                           (:known :variable))
  (register-simple-handler data::candidateInferenceOf
                           ;; Test
                           candidate-inference-of-find-inferences
                           (:variable :known))
  ;; (candidateInferenceContent ?candidateInference ?prop)
  (register-simple-handler data::candidateInferenceContent
                           ;; Test
                           candidate-inference-content-test
                           (:known :known))
  (register-simple-handler data::candidateInferenceContent
                           ;; Get content
                           candidate-inference-content-find-content
                           (:known :variable))
  ;; (supportScoreOf ?candidateInference ?n)
  (register-simple-handler data::supportScoreOf 
                           ;; Test
                           support-score-of-test
                           (:known :known))
  (register-simple-handler data::supportScoreOf 
                           ;; Test
                           support-score-of-find-score
                           (:known :variable))
  ;; (extrapolationScoreOf ?CandidateInference ?n)
  (register-simple-handler data::extrapolationScoreOf 
                           ;; Test
                           extrapolation-score-of-test
                           (:known :known))
  (register-simple-handler data::extrapolationScoreOf 
                           ;; Test
                           extrapolation-score-of-find-score
                           (:known :variable))
  ;; (candidateInferenceCorrespondences ?ci ?set)
  (register-simple-handler data::candidateInferenceCorrespondences
                           candidate-inference-correspondences-find-support
                           (:known :variable))
  source)

;; (candidateInferenceOf ?candidateInference ?mapping)

(defsource-handler 
    candidate-inference-of-test (ci mapping)
  (let ((real-ci (sme-referent ci source))
        (real-mapping (sme-referent mapping source)))
    (when (and (sme::candidate-inference? real-ci)
               (sme::mapping? real-mapping)
               (eq (sme::mapping real-ci) real-mapping))
      (generate-cached-single-ask-response
       nil (make-sme-relevance-antecedents (sme-of real-mapping))))))

(defsource-handler 
    candidate-inference-of-find-mapping (ci)
  (let ((real-ci (sme-referent ci source)))
    (when (sme::candidate-inference? real-ci)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (make-mapping-reference
                    (sme::mapping real-ci))))
       (make-sme-relevance-antecedents (sme-of real-ci))))))

(defsource-handler 
    candidate-inference-of-find-inferences (mapping)
  (let ((real-mapping (sme-referent mapping source)))
    (when (and (sme::mapping? real-mapping)
               (sme::inferences real-mapping))
      (generate-cached-multiple-ask-responses 
       (mapcar #'(lambda (ci)
                   (list (cons (cadr query)
                               (make-ci-reference ci))))
         (sme::inferences real-mapping))
       (make-sme-relevance-antecedents (sme-of real-mapping))))))

;; (candidateInferenceContent ?candidateInference ?prop)

(defsource-handler
    candidate-inference-content-test (ci prop)
  (let ((real-ci (sme-referent ci source)))
    (when (and (sme::candidate-inference? real-ci)
               (equal (sme->fire-expression
                       (sme::lisp-form (sme::form real-ci)))
                      prop))
      (generate-cached-single-ask-response
       nil (make-sme-relevance-antecedents (sme-of real-ci))))))

(defsource-handler
    candidate-inference-content-find-content (ci)
  (let ((real-ci (sme-referent ci source)))
    (when (sme::candidate-inference? real-ci)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (translate-ci-content real-ci)))
       (make-sme-relevance-antecedents (sme-of real-ci))))))

;; (supportScoreOf ?candidateInference ?n)

(defsource-handler
    support-score-of-test (ci n)
  (let ((real-ci (sme-referent ci source)))
    (when (and (sme::candidate-inference? real-ci)
               (numberp n)
               (= n (sme::support-score real-ci)))
      (generate-cached-single-ask-response
       nil (make-sme-timeclock-antecedents (sme-of real-ci))))))

(defsource-handler
    support-score-of-find-score (ci)
  (let ((real-ci (sme-referent ci source)))
    (when (sme::candidate-inference? real-ci)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (sme::support-score real-ci)))
       (make-sme-timeclock-antecedents (sme-of real-ci))))))
           
;; (extrapolationScoreOf ?CandidateInference ?n)

(defsource-handler
    extrapolation-score-of-test (ci n)
  (let ((real-ci (sme-referent ci source)))
    (when (and (sme::candidate-inference? real-ci)
               (numberp n)
               (= n (sme::extrapolation-score real-ci)))
      (generate-cached-single-ask-response
       nil (make-sme-timeclock-antecedents (sme-of real-ci))))))

(defsource-handler
    extrapolation-score-of-find-score (ci)
  (let ((real-ci (sme-referent ci source)))
    (when (sme::candidate-inference? real-ci)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (sme::extrapolation-score real-ci)))
       (make-sme-timeclock-antecedents (sme-of real-ci))))))

;; (candidateInferenceCorrespondences ?ci ?set)

(defsource-handler
    candidate-inference-correspondences-find-support (ci)
  (let ((real-ci (sme-referent ci source)))
    (when (sme::candidate-inference? real-ci)
      (generate-cached-single-ask-response
       (list (cons (third query)
                   (make-set (mapcar 'make-mh-reference
                               (sme::mhs real-ci)))))
       (make-sme-relevance-antecedents (sme-of real-ci))))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code