;;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10 -*- ;;;; --------------------------------------------------------------------------- ;;;; File name: eval-source.lsp ;;;; System: FIRE ;;;; Version: v1 ;;;; Author: Praveen Paritosh ;;;; Created: Jan 12, 2002 13:57:13 ;;;; Purpose: Provide evaluation of functions in FIRE ;;;; --------------------------------------------------------------------------- ;;;; Modified: Tuesday, December 16, 2003 at 19:16:38 by Ken Forbus ;;;; --------------------------------------------------------------------------- (in-package :fire) ;;;How to use the eval source. ;;; ;;;* What is it? ;;; The eval source provides a way for FIRE to evaluate lisp code associated ;;; with evaluatable functions/relations. Quite similar to Cyc's implementation ;;; of evaluation. The eval source gets triggered when it sees any query of the form ;;; (evaluate ?answer (someEvaluatableFunction ?x ?y)) ;;; The evaluatable form is passed off to evaluate-1, which is a simple interpreter ;;; that goes through the form, looks up the evalfn-table (a table that maintains ;;; the mappings between the Cyc symbols and lisp forms, stored with the KB (if ;;; it gets large, we might cache it, using a similar strategy as that used by ;;; the bc-index)) and binds the final result of the evaluation to ?answer. ;;; If needed, it will be easy to also cache away intermediate computations of ;;; subforms of the orginal evaluatable form, but we dont do that now. Right now ;;; the function definitions are in fire:*fire-path*\\evalfns.lsp, but they should ;;; be closer to the KB, probably in the KB's Resources directory. Comments? ;;; ;;;* Setting it up ;;; 1. Add the eval source: (add-eval-source ) ;;; 2. Load the file that contains definitions for the evaluatable ;;; functions: (load-file fire:*fire-path* "evalfns") ;;; ;;;* Querying ;;; All queries must be of the form (data::evaluate ?answer ?form). The ;;; result of evaluating ?form is bound to ?answer. If ?answer is bound ;;; before the query, the query returns non-nil if the ?answer is equal ;;; to the correct result of evaluating ?form, otherwise nil. For example, ;;; (fire:ask-it '(data::evaluate ?sum (data::PlusFn 1 2))) ;;; will bind ?sum to 3; and the following will return nil ;;; (fire:ask-it '(data::evaluate 4 (data::PlusFn 1 2))) ;;; ;;;* Adding new evaluatable functions ;;; The defEvalFn macro allows you to write the definition for a symbol ;;; that stands for an EvaluatableFunction in the KB. ;;; (defEvalFunction ;;; :args ;; list of variables, or :n-ary ;;; :lispcode ;; lisp code that implements the function ;;; :axioms ;; list of assertions about this function ;;; ;; that will be added to the KB. ;;; :documentation) ;;; For example, (more in fire:*fire-path*\\evalfns.lsp) ;;; (defEvalFn data::LengthOfListFn ;;; :args (?list) ;;; :lispcode (length ?list) ;;; :documentation "Computes the length of a list" ;;; :axioms ((arg1Isa LengthOfListFn List) ;;; (resultIsa LengthOfListFn NonNegativeInteger))) ;;; ;;;* Error Handling ;;; We dont want to run into hard lisp errors. If you write a definition ;;; for an EvaluatableFunction, please make sure that you do check for things ;;; that cause lisp errors. Currently there is minimal error handling, so if ;;; any of the (lisp handlers for) evaluatable functions returns :eval-error, ;;; the evaluate-1 understands that it cant handle the current query, and ;;; returns nil. So, in all cases that the lisp handler cant do the evaluation ;;; make sure you return :eval-error. ;;; ;;;* Resetting the contents of the eval functions table ;;; (fire:reset-evalfn-table ) ;;; ;;; TODO -- 1. Units ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod add-eval-source ((reasoner reasoner)) (let ((source (make-instance 'source :reasoner reasoner))) (add-source source reasoner) ;; This is for queries like ;; (evaluate ?answer (PlusFn 23 (ExponentFn 2 (LengthFn '(a b c))))) ;; evaluates the second argument and binds the result to the first. (register-ask-source reasoner 'data::evaluate source 'do-evaluate '(:variable :anything) '(:input-only :input-only) :medium) ;; This is for when queries like ;; (evaluate 45 (PlusFn 40 5)), the intention being ;; to test the truth of the ground statement. (register-ask-source reasoner 'data::evaluate source 'do-evaluate-ground '(:known :known) '(:input-only :input-only) :medium) source)) (defun do-evaluate (source context number response effort query answer expr) (let ((ans (evaluate-1 expr (reasoner source) context number response effort))) (let* ((binding-list (list (cons answer ans))) (bound-result (sublis binding-list query))) ;; Cache result in reasoner (tell bound-result (reasoner source) :eval-source context) (list (case response (:bindings binding-list) (:pattern (sublis binding-list query)) (t (sublis binding-list response))))))) (defun do-evaluate-ground (source context number response effort query answer expr) (let ((ans (evaluate-1 expr (reasoner source) context number response effort))) ;; Did we get the same answer? (if (equal ans answer) (progn (tell query (reasoner source) :eval-source context) (list (case response (:bindings '(nil)) (:pattern query) (t query)))) (values nil nil)))) ;; Probably should cache away separately the results of evaluating ;; the subforms, not done now. (defun evaluate-1 (form reasoner context number response effort) (cond ((null form) nil) ((numberp form) form) ((atom form) form) ; `(quote ,form)? ((listp form) (cond ((or (evaluatable-function? (car form)) ;; Like PlusFn (produces-evaluatable-function? (car form)) (fire-evaluatable-function? (car form))) (let* ((function-name (car form)) (given-args (cdr form)) (given-arity (length given-args)) ;; This gets the handler form from the evalfn-table (handler (get-lisp-handler function-name (kb reasoner))) (arity (first handler)) (args (second handler)) (lispcode (third handler)) (eval-result nil)) ;; TODO - Errorchecking by argIsa's (cond ((eql arity :n-ary) (setq eval-result (eval `(funcall #'(lambda (,args) ,lispcode) ',(mapcar #'(lambda (elt) (evaluate-1 elt reasoner context number response effort)) given-args)))) (if (eql eval-result :eval-error) (return-from evaluate-1 nil) (return-from evaluate-1 eval-result))) ((and (integerp arity) (eql arity given-arity)) (setq eval-result (eval `(funcall #'(lambda ,args ,lispcode) ,@ (mapcar #'(lambda (elt) (quote-if-needed (evaluate-1 elt reasoner context number response effort))) given-args)))) (if (eql eval-result :eval-error) (return-from evaluate-1 nil) (return-from evaluate-1 eval-result))) (t (return-from evaluate-1 nil))))) ;; something went wrong, return nil ((and (listp (car form)) (produces-evaluatable-function? (caar form))) ;; Like FunctionToArg ;; Tried to make this more general, but then realized that one cannot know ;; the arity of the function without a lot more information! ;; First get the procedure, and apply it to the arguments (let* ((procedure (evaluate-1 (car form) reasoner context number response effort)) (args (mapcar #'(lambda (arg) ;; Removed quote-if-needed here. 11/12/03 (TRH) (evaluate-1 arg reasoner context number response effort)) (cdr form))) (eval-result (apply procedure args))) (if (eql eval-result :eval-error) (return-from evaluate-1 nil) (return-from evaluate-1 eval-result)))) ;; We hit something that isnt evaluatable. Various things ;; we could do here -- go ASK, or signal something to say ;; that we hit something thats not defined to be evaluated. ;; Right now, we do the simplest thing, just returns the form. ;; (ask form reasoner context number response effort))) ;;(return-from evaluate-1 :UNDEFINED-FUNCTION))) (t `(quote ,form)))) (t form))) (defun fire-evaluatable-function? (pred) ;; There are things for which a sensible procedural interpretation exists ;; e.g., TheSetOf but which aren't in EvaluatableFunction in Cyc. Since ;; we think there won't be many of these, and new predicates that we add ;; can include EvaluatableFunction as a genl, we just keep a small list ;; of those special cases here. (eq pred 'data::TheSetOf)) (defun quote-if-needed (thing) ;; Subtle issue: In the Lisp world, things like symbols and s-expressions need to ;; be quoted. In the Logic world, these represent entities, predicates, and statements, ;; which should not be quoted. So inside the evaluation process, we may need to keep ;; wrapping quotes around things to keep from having lisp errors. (cond ((symbolp thing) `(quote ,thing)) ((listp thing) (if (eq (car thing) 'quote) thing `(quote ,thing))) (t thing))) (defun get-lisp-handler (function-name *kb*) (let ((handler (gethash function-name (evalfn-table *kb*)))) (values handler))) ;; Should have total consistency with the KB. If a predicate is ;; an evaluatable function, then -- 1. KB knows about it, its ;; arity, resultisa and argisas. Two possibilities - 1. user is ;; defining a new function, or 2. user is adding a handler for ;; a function already in the KB. (defmacro defEvalFn (name &rest keyed-items) `(parse-eval-function ',name ',keyed-items)) (defun verify-function-expression (form) ;; TBD ;; go through and verify that the operators are the ones that we support (declare (ignore form)) nil) (defun parse-eval-function (name keyed-items) (let ((arity (get-arity-from-args (cadr (member :args keyed-items)))) (arglist (get-arglist-from-args (cadr (member :args keyed-items)))) (lispcode (cadr (member :lispcode keyed-items))) (documentation (cadr (member :documentation keyed-items))) (axioms (cadr (member :axioms keyed-items))) (assertions nil)) ;; Now - 1.Add this to the EvalFnTable, 2. Add this to the KB? ;; Q: Do we assume that the symbol for the function is already ;; there in the KB, and one is just adding the defn? (and *kb* ;; also add axioms to kb about this function, argisas and resultisa ;; must do that. but for now, lets just have all the function info ;; in the table; just for now. (add-to-evalfn-table *kb* name arity arglist lispcode) ;; Tell the WM. Question - When should we store in KB? - NOW. ;;; (if (null (evaluatable-function? name)) ;;; (tell (make-eval-function-declaration name) *reasoner* :EvalFnDefinition nil)) (push (make-arity-assertion name :function arglist (if (eq arity :n-ary) '(:n-ary? t) nil)) assertions) (push (make-eval-function-declaration name) assertions) (push (make-lisp-definition name (->data (list arity arglist lispcode))) assertions) (push (make-comment-statement name documentation) assertions) (add-to-kb (append assertions axioms) *kb*) ))) (defun get-arity-from-args (form) (if (eql (car form) :n-ary) :n-ary (length form))) (defun get-arglist-from-args (form) (if (eql (car form) :n-ary) (cadr form) form)) (defun add-to-evalfn-table (kb name arity arglist lispcode) (setf (gethash name (evalfn-table kb)) (list arity arglist lispcode))) (defun add-to-kb (axioms kb) (dolist (axiom axioms) (store axiom kb))) (defun reset-evalfn-table (kb) (setf (evalfn-table kb) (make-hash-table))) (defun show-evalfn-table (&optional (kb *kb*)) (hash-table-entries (evalfn-table kb))) (defun hash-table-entries (table) (let ((all-entries '())) (maphash #'(lambda (k v) (push (list k v) all-entries)) table) all-entries)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; End of code