;;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10 -*- ;;;; --------------------------------------------------------------------------- ;;;; File name: defs.lsp ;;;; System: ;;;; Version: v1 ;;;; Author: Ken Forbus ;;;; Created: November 17, 2000 23:24:26 ;;;; Purpose: Class definitions ;;;; --------------------------------------------------------------------------- ;;;; Modified: Friday, April 23, 2004 at 10:05:04 by hinrichs ;;;; --------------------------------------------------------------------------- (in-package :fire) (defvar *kb* nil) (defclass knowledge-base () ((db :type t :initarg :db :accessor db :documentation "Pointer to BDL database hosting KB") (path :type t :initarg :path :reader path :documentation "Path to KB BDL database files") (name :type t :initarg :name :reader name :documentation "File name used for KB BDL database files") (state :type t :initarg :state :accessor state :initform :closed :documentation "State = :open | :closed depending on database state") (predicate-style :type t :reader predicate-style :initarg :predicate-style :initform :hyphen :documentation "predicate style = :mixed or :hypen") (id-counter :type fixnum :accessor id-counter :initform -1 :documentation "ID counter for cached SME predicates.") (chainers :type t :initform nil :initarg :chainers :accessor chainers :documentation "List of chainers for backchaining") (evalfn-table :type hash-table :initform (make-hash-table) :initarg :evalfn-table :accessor evalfn-table :documentation "TBA") (structural-cache :type t :initform nil :accessor structural-cache :documentation "Structural cache holds basic predicate information.") (case-libraries :type t :initform nil :accessor case-libraries :documentation "Case libraries cached with this KB.") (lock :documentation "Thread lock that prevents multiple threads from accessing a given database at the same time." :accessor lock :initarg :lock :initform (mp:make-process-lock :name "KB Lock")) (plist :documentation "Place to stash application-specific data." :accessor plist :initform nil))) (defmethod print-object ((kb knowledge-base) stream) (format stream "" (path kb) (name kb) (state kb) (id-counter kb))) (defmethod kb? ((kb knowledge-base)) t) (defmethod kb? ((kb t)) nil) (defun recompute-structural-cache (&key (kb *kb*)) (format t "~%Recomputing structural cache (this will take awhile)...~%") (clear-structural-cache kb) (repopulate-structural-cache :kb kb) (perform-offline-structural-inferences :kb kb)) ;;; Ensuring reading occurs in the desired package, thanks to JE (defvar *form-package* (find-package :cl-user)) (defun read-in-package (&optional stream eof-errorp eof-value recursivep (*form-package* *form-package*)) (let ((*package* *form-package*)) ;; ***** use unwind-protect? (read stream eof-errorp eof-value recursivep))) ;;;;;;; Sources ;; See sources.lsp for comments and methods (defclass source () ((reasoner :type t :initarg :reasoner :reader reasoner))) (defmethod kb ((thing source)) (kb (reasoner thing))) (defclass source-registry-entry () ((functor :type t :initarg :functor :reader functor) (reasoner :type t :initarg :reasoner :reader reasoner))) ;; N.B. Inheriting from source-registry-entry in the classes below is a little ;; space-inefficient, since one could pass around the entry for the functor, ;; but the extra clarity in debugging is worth it, IMHO. (defclass source-registry-handler-entry (source-registry-entry) ((source :type t :initarg :source :reader source) (signature :type t :initarg :signature :reader signature) (handler :type t :initarg :handler :reader handler :documentation "Procedure for invoking the source with this signature"))) (defclass source-registry-ask-entry (source-registry-handler-entry) ((result-signature :type t :initarg :result-signature :reader result-signature) (effort-type :type t :initarg :effort-type :reader effort-type :documentation "Symbol indicating cost of using source"))) (defmethod source-registry-ask-entry? ((thing t)) nil) (defmethod source-registry-ask-entry? ((thing source-registry-ask-entry)) t) (defclass source-registry-tell-entry (source-registry-handler-entry) nil) (defclass source-registry-functor-entry (source-registry-entry) ((ask-entries :type t :initform nil :accessor ask-entries) (tell-entries :type t :initform nil :accessor tell-entries))) (defmethod source-registry-functor-entry? ((thing source-registry-functor-entry)) t) (defmethod source-registry-functor-entry? ((thing t)) nil) (defun show-source-registry (&key (reasoner *reasoner*) (stream *standard-output*)) ;; Add signature information later. (format stream "~%For reasoner ~A:" reasoner) (maphash #'(lambda (key value) (declare (ignore key)) (format stream "~% ~A: ~D ask, ~D tell." (functor value) (length (ask-entries value)) (length (tell-entries value)))) (registry reasoner))) ;;;;;;; Reasoners ;; See reasoner.lsp for comments and methods (defclass reasoner () ((title :type t :initarg :title :reader title :documentation "String used for identification") (kb :type knowledge-base :initarg :kb :reader kb :documentation "Knowledge base used by this reasoner.") (sources :type list :accessor sources :initarg :sources :initform nil :documentation "List of sources associated with this reasoner") (registry :type t :initform (make-hash-table :test 'equal) :reader registry :documentation "Associates predicates and sources") (chainers :type t :initform nil :initarg :chainers :accessor chainers :documentation "List of chainers for backchaining.") (ltre :type t :accessor ltre :documentation "LTRE serving as working memory for this reasoner.") (agenda :type list :initform nil :accessor agenda :documentation "Agenda for reasoner, used by the Solve mechanism.") (queries :type list :accessor queries :initform nil :initarg :queries :documentation "Queries being processed by this reasoner.") (queue :type list :accessor queue :initform nil :initarg :queue :documentation "Pending queries") (lock :documentation "Thread lock that prevents multiple threads from accessing a given reasoner at the same time." :accessor lock :initarg :lock :initform (mp:make-process-lock :name "Reasoner Lock")) (plist :documentation "Property list for random application-specific stuff." :accessor plist :initform nil))) (defmethod print-object ((r reasoner) stream) (format stream "" (title r))) (defmethod reasoner? ((r reasoner)) t) (defmethod reasoner? ((r t)) nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Backchaining subsystem definitions ;;; See backwards.lsp for comments and methods. ;;; Clauses (defclass clause () ((id :type fixnum :reader id :initarg :id :documentation "Integer ID for the clause") (chainer :type t :reader chainer :initarg :chainer :documentation "chainer it belongs to.") (variables :type t :reader variables :initarg :variables :documentation "List of all the variables used in the clause") (terms :type t :reader terms :initarg :terms :documentation "List of terms. Note that they wont be ground usually") (axiom :type t :reader axiom :initarg :axiom :documentation "A pointer to the axiom that spawned the clause. Simplest, the s-expression itself."))) ;; N.B. Clauses really are static structures -- we don't want anyone modifying them. ;; Hence the use of :reader rather than :accessor above. This does mean that all properties ;; must be established at clause creation time. (defmethod clause? ((c t)) nil) (defmethod clause? ((c clause)) t) (defmethod print-object ((cl clause) stream) (format stream "<~A(~A)>" (id cl) (chainer cl))) (defmethod describe-object ((cl clause) stream) (format stream "~%Clause ~A of ~A:" (id cl) (chainer cl)) (format stream "~%Variables: ~A" (variables cl)) (format stream "~%Terms:~% ~A" (terms cl)) (format stream "~%Original axiom:~% ~A" (variables cl))) ;;; Quantified Terms (defclass quantified-term () ((form :type list :reader form :initarg :form :documentation "Sexpr representing the formula") (expansion :type list :reader expansion :initarg :expansion :documentation "CNF expansion of the body of the term") (var :type symbol :reader var :initarg :var :documentation "The variable over which the term is quantified."))) (defmethod quantified-term? ((tm t)) nil) (defmethod quantified-term? ((tm quantified-term)) t) (defmethod describe-object ((tm quantified-term) stream) (format stream "Quantified Term: ~A" (form tm))) ;;;;;; Chainer (defclass chainer () ((term :type t :initform nil :initarg :term :reader term :documentation "Expression denoting this chainer") (title :type t :initarg :title :reader title :initform "" :documentation "String used for printing") (kb :type knowledge-base :initarg :kb :reader kb :documentation "Knowledge base used as the source of axioms.") (table :type hash-table :initform (make-hash-table) :reader table :documentation "Maps from predicates to clauses where it appears") (clauses :type hash-table :initform (make-hash-table) :reader clauses :documentation "Hash table clauses in the chainer, key = integer ID") (clause-counter :type fixnum :initform -1 :accessor clause-counter :initarg :clause-counter ;for when reloading :documentation "Number of clauses in the chainer") (file-name :type t :initform "" :initarg :file-name :accessor file-name :documentation "Name of file, for caches stored to disk."))) (defmethod chainer? ((c chainer)) t) (defmethod chainer? ((c t)) nil) (defmethod n-clauses ((c chainer)) (1+ (clause-counter c))) (defmethod n-clauses ((c t)) 0) ;;; N.B. the list of clauses is to simplify reconstruction. n-clauses is both for statistics ;;; and to enable heuristic choice of chainer via size. While currently we're viewing chainer ;;; construction as a batch operation, the need to reconstruct them via loading and the ;;; downstream potential for incremental updates means we're using :accessor rather than :reader ;;; here. ;;; The assumption re the table is that we'll store two lists in each value, one consisting ;;; of terms where it appears with a positive sign and one where it appears with a negative sign. (defmethod print-object ((ci chainer) stream) (format stream "" (title ci) (n-clauses ci))) ;;;; --------------------------------------------------------------------------- ;;; END OF CODE