;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: sluice.lsp
;;;;    System: FIRE
;;;;   Version: 1.0
;;;;    Author: Ken Forbus
;;;;   Created: February 26, 2001 08:33:27
;;;;   Purpose: Extract knowledge relevant to some particular entity or predicate
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Wednesday, May 8, 2002 at 19:40:48 by usher
;;;; ---------------------------------------------------------------------------

(in-package :fire)


;;; Unit testing

(defparameter *cyc-ikb-kb-path* (make-qrg-path "FIRE" "KBs" "Cyc"))
(defparameter *cyc-ikb-kb-name* "cyc")

(defun test-sluicer (&key (kb :ikb)(title "Sluice test"))
  (unless (typep *kb* 'knowledge-base)
    (ecase kb
      (:ikb (make-kb *cyc-ikb-kb-path*
                     *cyc-ikb-kb-name*))))
  (unless (eq (state *kb*) :open) (open-kb))
  (setq data::r (make-reasoner title))
  (add-analogy-source data::r)
  (setq data::a (car (sources data::r))))

(defun expressions-mentioning (term)
  (mapcar 'car 
    (mp:with-process-lock ((lock *kb*))
      (dbex::super-exp term t :specs))))

;;; From Expl-gen
(defun pretty-print-to-string (form &optional (width 40.))
   "Pretty-prints a LISP expression to a string.  The output is constrained
    to a width that is the number of characters specified by width."
   (let ((*print-right-margin* width))
      (remove-leading-newline 
       (with-output-to-string (s)
         (pprint form s)))))

(defun remove-leading-newline (string)
   (if (eq (elt string 0) #\Newline)
      (subseq string 1)
      string))
  
(defun mentions-report (file terms)
  (with-open-file (fout file :direction :output :if-exists :supersede)
    (format fout "~%Report for ~A.~%" terms)
    (dolist (term terms)
      (let ((exps (expressions-mentioning term))
            (counter 0))
        (format fout "~%~%For ~A:" term)
        (if exps (format fout "~D expressions." (length exps))
          (format fout "No expressions."))
        (dolist (exp exps)
          (format fout "~%~D: ~A" (incf counter)
            (pretty-print-to-string exp 75.)))))
    (format fout "~%~%End of mentions report.")))

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