;;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10 -*- ;;;; --------------------------------------------------------------------------- ;;;; File name: sources.lsp ;;;; System: FIRE ;;;; Version: 1.0 ;;;; Author: Ken Forbus ;;;; Created: December 11, 2000 21:11:29 ;;;; Purpose: Basic operations on sources ;;;; --------------------------------------------------------------------------- ;;;; Modified: Sunday, February 22, 2004 at 17:56:46 by Kenneth Forbus ;;;; --------------------------------------------------------------------------- (in-package :fire) ;;;; Sources in FIRE ;; ;; Sources provide reasoning and fact lookup methods that lie outside the usual ;; reasoner mechanisms. Sources are what make FIRE a federated architecture; ;; they provide the interface to other facilities, such as analogical processing ;; software, spatial reasoners, and other facilities and information sources. ;; ;; Sources interface with a reasoner by handling particular predicates. All ;; predicates must be defined within the KB. (n.b. this is a departure from the ;; model we used in DTE, where KB's were just another source and any source could ;; provide definitions. Distinguishing the KB's role better fits the way DTE was ;; actually used, and provides a cleaner model.) Sources provide special-purpose ;; ways of retrieving or deriving facts for a set of predicates. Thus sources can ;; be viewed as specialized routines that are called by the reasoner. However, the ;; source can in turn rely on the reasoner for knowledge outside its expertise. ;; This makes the reasoning process more uniform, and should reduce the amount of ;; redundant information cached internal to sources. ;; ;; Since the code for sources interacts strongly with the code for reasoners, the ;; code for registering sources with reasoners is in the reasoner file, with the ;; code in this file being the definitions of source registry entries and associated ;; constraints. ;;; See defs.lsp for class definitions ;;; A source serves a single reasoner. If there is some program or service that ;;; serves multiple programs, the role of a source is provide an interface to that ;;; service. ;;; Part of the philosophy for sources is that they can expose a number of ;;; procedural interfaces, each corresponding to a distinct capability it provides. ;;; This relatively fine-grained interface is required in order to better inform ;;; the reasoner as to its options. Query optimization across multiple sources simply ;;; is not possible without a reasonable amount of information about when a source ;;; can provide information, and what sorts of information it can provide. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The Registry for sources ;; When a source is added, information about the predicates it is concerned with ;; is added to the reasoner's registry. Registry entries contain the following ;; fields: ;; FUNCTOR: The predicate or function in question. ;; SOURCE: The source that this entry was added for. ;; SIGNATURE: The types assumed for each argument, using the information from the KB. ;; Also describes which arguments must be known and which arguments can be ;; computed by the source. This information is essential for the reasoner ;; to perform query optimization. ;; QUERY-HANDLER: The procedure to be called when the signature is satisfied. ;; TELL-POLICY: Does this source require that the reasoner inform it whenever ;; a new statement of this type is the argument of a TELL? ;; EFFORT-TYPE: Indicates the amount of effort required to invoke the source. ;; This is intended to help the reasoner respect imposed resource limitations. ;; ;; If a source provides multiple services, it should register each handler ;; independently. Avoiding redundant handlers or contradictory handlers is ;; the responsibility of the source author. ;; ;; It is presumed that registry entries are immutable, since a source should not ;; be changing its services. (This is unlike the assumptions in the agent world, ;; for instance.) ;; ;; This registry information is used in several ways: ;; 1. When ASK is invoked, it checks the registry to see if there is a ;; special-purpose way of answering the query. If so, that method is used. ;; [Issue: Use QUERY-PROCEDURES field or dispatch via the ASK method? ;; The signature information could be used to do prefiltering.] ;; 2. When TELL adds a fact, it must call TELL recursively on those sources that ;; asked for such information. ;; 3. When the reasoner is looking over conjunctive goals, it must take the ;; query constraints into account when reordering conjuncts, so that the ;; constraints on what sources can do are honored. This is important, since ;; some sources can only handle variables in specific subsets of their arguments, ;; or are dramatically efficient depending on what are variables and what are constants. ;; The language of signatures is the following: ;; Signatures have a signature (for queries and tells) and a result signature. ;; For the query signature: ;; For fixed-arity predicates: ;; Each argument entry consists of a constraint, ;; where = :VARIABLE | :KNOWN ;; | (:ISA ) | (:TEST ) | :ANYTHING ;; The meanings of the entries are ;; :VARIABLE the query has a pattern in that position. ;; :KNOWN the query has something that isn't a variable in that position. ;; (Issue: What about NATs? Should :VARIABLE = non-ground, :KNOWN = ground?) ;; (:ISA ) is like :KNOWN, but the argument must be a member of the ;; collection . ;; (:TEST ) is like :KNOWN, but the argument must satisfy the Lisp ;; procedure . (Good for filtering out non-numerical args, for instance.) ;; :ANYTHING means no constraint on that argument. ;; For n-ary predicates, things are a bit complex because we would like to advertise ;; correctly when a source can or cannot solve a problem. For instance, a numerical ;; constraint solver source might want to say ;; (1 :variable) (:rest (:test numberp)) ;; i.e., exactly one of the arguments is unknown and the rest are numbers, so that ;; it will only be used when an expression can be solved. Consequently, for n-ary ;; predicates we assume the same language of constraints, but with the following ;; cardinality constraints: ;; :ALL means the constraint must be satisfied for all arguments. ;; :SOME means the constraint must be satisfied for at least one argument. ;; means exactly that number of arguments must satisfy the constraint. ;; :REST means that, with the exception of arguments that satisfy some other constraint, ;; every remaining argument must satisfy the given constraint. If there are no other ;; constraints this equivalent to :ALL. It is an error to have more than one :REST ;; constraint in a query signature. ;; ;; The result signature expresses what arguments the handler can provide a value for. ;; This information is needed for query optimization, so that inappropriate demands ;; are not made on sources. For fixed-arity predicates, the entries are either ;; :PRODUCES -- always provides a value for this variable. ;; :CAN-PRODUCE -- will provide a value if this is a variable on query. ;; :INPUT-ONLY -- cannot produce a value for this variable. ;; For n-ary predicates, we'll use the same cardinality constraints on this language. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Evaluating constraints (defun signature-constraint-satisfied? (arg constraint reasoner) (cond ((null constraint) t) ((eq constraint :anything) t) ((eq constraint :variable) (ltre::variable? arg)) ((eq constraint :known) (not (ltre::variable? arg))) ((listp constraint) (cond ((eq (car constraint) :isa) (instance-of? arg (cadr constraint) reasoner)) ((eq (car constraint) :test) (funcall (cadr constraint) arg)))))) (defmethod evaluate-signature-constraints ((fact list)(entry source-registry-handler-entry) &optional (kb *kb*)) ;; Assume functor matches, since we wouldn't have gotten here otherwise. (cond ((n-ary? (car fact) :kb kb) (evaluate-signature-nary-constraints (signature entry) (cdr fact) (reasoner entry))) (t (evaluate-signature-fixed-arity-constraints (signature entry) (cdr fact) (reasoner entry))))) (defun evaluate-signature-nary-constraints (signature arguments reasoner) ;; Assumes clever ordering of constraints, i.e., :REST is last. ;; We also assume that life is not complex, i.e., that the constraints ;; are fairly simple without the need to search for multiple solutions of them. ;; Given the ability to use arbitary procedural tests, this code would get ;; extremely hairy to be correct in all situations. (cond ((null signature) t) ((not (listp (car signature))) (error "N-ary constraint signature format violation:~A ~A ~A" signature arguments reasoner)) ((or (eq (caar signature) :all) (eq (caar signature) :rest)) (if (every #'(lambda (arg) (signature-constraint-satisfied? arg (cadar signature) reasoner)) arguments) (evaluate-signature-nary-constraints (cdr signature) arguments reasoner))) ((numberp (caar signature)) ;; remove satisfiers (let ((winners (remove-if-not #'(lambda (arg) (signature-constraint-satisfied? arg (cadar signature) reasoner)) arguments))) (if (= (length winners) (caar signature)) (evaluate-signature-nary-constraints (cdr signature) (set-difference arguments winners :test 'equal) reasoner)))))) (defun evaluate-signature-fixed-arity-constraints (signature arguments reasoner) ;; Tacitly assumes that the arity of the constraints and the predicate are the ;; same. Don't want overhead of testing this each time. May want to add ;; some error-checking at source registration time to prevent subtle lossage. (every #'(lambda (constraint argument) (signature-constraint-satisfied? argument constraint reasoner)) signature arguments)) ;;;;;;;;;;;; ;; Gathering relevant handlers (defmethod gather-query-ask-handlers ((query list) (reasoner reasoner)) (let ((results nil) (entry (gethash (car query) (registry reasoner)))) (when entry (dolist (ask-entry (ask-entries entry) results) (when (evaluate-signature-constraints query ask-entry (kb reasoner)) (push ask-entry results)))))) (defmethod query-ask-arglist ((query list) (entry source-registry-ask-entry)) (values (source entry) (delete :the-forbidden-value ;; can't use nil, it's often used as a value. (mapcar #'(lambda (arg constraint) (if (eq constraint ':input-only) arg :the-forbidden-value)) (cdr query) (result-signature entry))))) (defmethod any-sources-for? ((query list) (reasoner reasoner)) "Returns non-nil if there are sources that could answer this query, nil o.w." ;; This is a quick heuristic check to see if there is a specialist ;; around. See ask-tell.lsp for motivation. (let ((entry (gethash (car query) (registry reasoner)))) (when entry (dolist (ask-entry (ask-entries entry)) (if (evaluate-signature-constraints query ask-entry (kb reasoner)) (return-from any-sources-for? (values ask-entry))))))) (defmethod predicate-has-source? ((pred t) (reasoner t)) nil) (defmethod predicate-has-source? ((pred t) (reasoner reasoner)) (gethash pred (registry reasoner))) (defmethod predicate-ask-signatures ((pred t) (reasoner t)) nil) (defmethod predicate-ask-signatures ((pred t) (reasoner reasoner)) (let ((entry (gethash pred (registry reasoner)))) (when entry (delete nil (mapcar #'(lambda (x) (when (source-registry-ask-entry? x) (result-signature x))) (ask-entries entry)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Debugging utilities (defun show-registry-ask-entry (entry &key (stream *standard-output*)) (format stream "~&~A: ~A" (functor entry) (signature entry)) (format stream "~&Results: ~A." (result-signature entry)) (format stream "~&Code: ~A, ~A." (handler entry) (effort-type entry))) (defun show-ask-handlers-for (predicate &key (stream *standard-output*) (reasoner *reasoner*)) (let ((entry (gethash predicate (registry reasoner))) (count 0)) (cond ((null entry) (format stream "~% ~A unregistered in ~A." predicate (title reasoner))) (t (format stream "~&Ask handlers for ~A:" predicate) (dolist (ask-entry (ask-entries entry)) (incf count) (format stream "~%---------------") (show-registry-ask-entry ask-entry :stream stream)) (if (= count 0) (format stream " None.")) entry)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Some utilities for simplifying writing of handlers for sources ;;; The responses to ASK are very stereotyped, so we modularize them ;;; here (defun generate-single-ask-response (query response binding-list) (case response (:bindings (list binding-list)) (:pattern (list (sublis binding-list query))) (t (list (sublis binding-list response))))) (defun generate-multiple-ask-responses (query response binding-lists) (case response (:bindings binding-lists) (:pattern (mapcar #'(lambda (binding-list) (sublis binding-list query)) binding-lists)) (t (mapcar #'(lambda (binding-list) (sublis binding-list response)) binding-lists)))) ;; Most sources justify results in the WM's LTMS. These response procedures ;; encapsulate the work involved. (defun generate-cached-single-ask-response (query response binding-list antecedents informant) (let ((answer-form (sublis binding-list query))) (justify-result answer-form antecedents informant) (case response (:bindings (list binding-list)) (:pattern (list answer-form)) (t (list (sublis binding-list response)))))) (defun generate-cached-multiple-ask-responses (query response binding-lists antecedents informant) (let ((answer-forms (mapcar #'(lambda (binding-list) (sublis binding-list query)) binding-lists))) (dolist (answer-form answer-forms) (justify-result answer-form antecedents informant)) (case response (:bindings binding-lists) (:pattern answer-forms) (t (mapcar #'(lambda (binding-list) (sublis binding-list response)) binding-lists))))) (defmacro defsource-handler (name other-args &rest body) (let* ((real-args (append '(source context number response effort query) other-args)) (real-body (replace-all-response-patterns body (make-keyword name))) (declaration (make-source-handler-ignore-declaration real-body))) `(defun ,name ,real-args ,@ declaration ,@ real-body))) (defun replace-all-response-patterns (body informant) (cond ((null body) nil) ((not (listp body)) body) ((or (eq (car body) 'generate-single-ask-response) (eq (car body) 'generate-multiple-ask-responses)) (cons (car body) (append '(query response) (cdr body)))) ((or (eq (car body) 'generate-cached-single-ask-response) (eq (car body) 'generate-cached-multiple-ask-responses)) (cons (car body) (append '(query response) (cdr body) (list informant)))) (t (cons (replace-all-response-patterns (car body) informant) (replace-all-response-patterns (cdr body) informant))))) (defun make-source-handler-ignore-declaration (code) (let ((unused-variables (find-all-unused-variables code (copy-list '(source context number effort query))))) (when unused-variables `((declare (ignore ,@ unused-variables)))))) (defun find-all-unused-variables (body variables) (cond ((null body) variables) ((not (listp body)) (if (member body variables) (remove body variables) variables)) (t (find-all-unused-variables (cdr body) (find-all-unused-variables (car body) variables))))) (defmacro register-simple-handler (predicate procedure-name signature) (let ((io-signature (produce-io-signature signature))) `(register-ask-source reasoner ',predicate source ',procedure-name ',signature ',io-signature :medium))) (defun produce-io-signature (signature) (mapcar '(lambda (entry) (ecase entry (:known :input-only) (:variable :produces))) signature)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Stub (defun tell-appropriate-sources (fact reason context reasoner) (declare (ignore fact reason context reasoner)) ;; stub nil) ;;;; --------------------------------------------------------------------------- ;;; END OF CODE