;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: reasoner.lsp
;;;;    System: FIRE
;;;;   Version: v1
;;;;    Author: Ken Forbus
;;;;   Created: December 7, 2000 17:26:05
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: #<Printer Error, obj=#x20001485: attempt to call `cgx:date*' which is an undefined function.>
;;;; ---------------------------------------------------------------------------

(in-package :fire)

;;; How Reasoners work
;;;
;;; The Reasoner object provides the locus of activity in a FIRE application.
;;; It has the following parts (see defs.lsp for details):
;;; *** The KB provides the definitions of predicates and much of the knowledge of the
;;;  reasoner.
;;; *** A list of sources.  Sources provide specialized reasoning or data
;;;  storage.  (N.B. unlike DTE, KB's are special, they are not sources.
;;; *** A Registry that maps predicates to sources.  Ask/Tell use this to figure out if they
;;;  should use the KB or a source.
;;; *** An LTRE that serves as the working memory for the reasoner.
;;; N.B. Queries is not used yet.  
;;; *** Queries is a list of queries that is being worked on by the reasoner.
;;;  The intent is that queries will be threaded, so they can be operated in parallel.
;;;  A key reason for this is that we want sources to go back to the reasoner for
;;;  queries regarding areas outside their expertise, and we can't have those
;;;  blocking waiting for the source to return.
;;; Queue is a list of queries added by other processes that should be
;;;  serviced by the reasoner.
;;; See defs.lsp for class definitions.

(defvar *reasoner* nil "Register holding current reasoner.")

(defun in-reasoner (reasoner)
  (setq *reasoner* reasoner)
  (ltre::in-ltre (ltre reasoner))
  (in-kb (kb reasoner))
  reasoner)

(defun make-reasoner (title &key (kb *kb*) (ltre-debug-flags nil)
                                 (type 'reasoner) 
                                 (analogy-source-type 'analogy-source))
  (let ((r (make-instance type 
             :title title :kb kb)))
    ;; **** Pass in LTRE debug flags?
    (setf (ltre r) (ltre::create-ltre 
                    `(:ltre-of ,title)
                    :dbg-flags ltre-debug-flags))
    (in-reasoner r)
    ;; The Analogy source is always part of the system.
    (add-analogy-source r :type analogy-source-type)
    r))

(defmethod get-documentation ((pred symbol) (kb reasoner))
  (get-documentation pred (kb kb)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Registration of sources

;; Registration of a source with a reasoner is handled
;; when that source is created.  The code here provides
;; setup routines that source creation code needs.

(defun add-source (source reasoner)
  (push source (sources reasoner)))

(defmethod find-or-make-functor-entry ((reasoner reasoner) (functor symbol))
  (let ((entry (gethash functor (registry reasoner))))
    (if (source-registry-functor-entry? entry) entry
      (add-source-registry-functor-entry functor reasoner))))

(defmethod add-source-registry-functor-entry ((functor symbol) (reasoner reasoner))
  (setf (gethash functor (registry reasoner))
    (make-instance 'source-registry-functor-entry :functor functor
      :reasoner reasoner)))

(defmethod register-ask-source ((reasoner reasoner) (functor symbol) (source source)
                                handler signature result-signature
                                effort-type)
  (push (make-instance 'source-registry-ask-entry
          :reasoner reasoner :functor functor :source source
          :handler handler
          :signature signature
          :result-signature result-signature
          :effort-type effort-type) 
        (ask-entries (find-or-make-functor-entry reasoner functor))))

(defmethod register-tell-source ((reasoner reasoner) (functor symbol) (source source)
                                 handler signature)
  (push (make-instance 'source-registry-tell-entry
          :reasoner reasoner :functor functor :source source
          :handler handler :signature signature)
        (tell-entries (find-or-make-functor-entry reasoner functor))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Useful lookup functions

(defmethod instance-of? (entity col (reasoner reasoner))
  (when (collection? col :kb (kb reasoner))
    (or (wm-instance-of? entity col reasoner)
        (instance-of? entity col (kb reasoner)))))

(defun wm-instance-of? (entity col reasoner)
  ;; for internal use only
  (let ((kb (kb reasoner))
        (ltre (ltre reasoner)))
    (some #'(lambda (isa-fact)
              (let ((isa-col (third isa-fact)))
                (or (equal isa-col col)
                    (spec-of? isa-col col :kb kb))))
        (ltre:fetch-trues `(data::isa ,entity ?x) ltre))))


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