;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: extraction.lsp
;;;;    System: 
;;;;    Author: Ken Forbus
;;;;   Created: December 6, 2001 09:14:17
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Friday, January 23, 2004 at 17:45:29 by usher
;;;; ---------------------------------------------------------------------------

(in-package :fire)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun facts-mentioning-thing (thing)
  (mp:with-process-lock ((lock *kb*))
    (dbex::super-exp thing t :ground :instances)))

(defun gather-things-of-type-in-facts (facts type)
  (let ((instances nil))
    (dolist (fact facts instances)
      (dolist (instance (gather-things-of-type-from-statement fact type))
        (pushnew instance instances :test 'equal)))))

(defun gather-things-of-type-from-statement (exp type)
  (when (or (null exp) (not (listp exp))) 
    (return-from gather-things-of-type-from-statement
      (values nil)))
  ;; Map over arguments, looking for the right kinds of things
  (mapcan #'(lambda (arg)
              (cond ((listp arg)
                     ;; An expression, but is it a NAT or a statement?
                     (cond ((eq (predicate-type (car arg)) :function)
                            ;; A nat.  Test it
                            ;; **** We're not going through the arguments to the NAT,
                            ;; **** although that might be a good idea.
                            ;; The test for constant-term? is to prevent variables
                            ;; from sneaking into the retrieval.
                            (when (and (constant-term? arg)
                                       (instance-of? arg type (or *reasoner* *kb*))
                              (list arg))))
                           (t ;; Otherwise an expression
                            (gather-things-of-type-from-statement arg type))))
                    ((variable? arg) 
                     nil) ;; Skip variables
                    ((instance-of? arg type (or *reasoner* *kb*))
                     (list arg))
                    (t nil)))
    (cdr exp)))

(defun things-of-type-related-to-thing (thing type)
  (gather-things-of-type-in-facts (facts-mentioning-thing thing)
                                  type))

(defun events-for-entity (entity)
  (things-of-type-related-to-thing entity 'd::Event))

(defun actors-for-event (event)
  (things-of-type-related-to-thing event 'd::Entity))

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