;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: rulemacros.lsp
;;;;    System: FIRE
;;;;   Version: v1
;;;;    Author: Daniel T Halstead
;;;;   Created: March 14, 2003 11:22
;;;;   Purpose: Handles rulemacros in Cyc, expanding them into their longer, 
;;;;            axiomatic form so that they can be reasoned with using query.
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Saturday, February 21, 2004 at 16:48:01 by Kenneth Forbus
;;;; ---------------------------------------------------------------------------

(in-package :fire)

(defvar *rmp-hash* nil)

; Call this to enable handling of rulemacros.  
; If it's never been called before, you may want to set make-chainer to t so that it 
;  saves all of the expanded macros into a chainer you can load next time.
(defun setup-rulemacros (chainer-title &key (kb *kb*) make-chainer verbose)
  (cond (make-chainer
         (rulemacro-hash :verbose verbose)
         (let ((chainer 
                (create-chainer-from-macros 
                 chainer-title (get-all-macros-from-kb :kb kb :verbose verbose) :kb kb)))
           (dump-chainer chainer)
           chainer))
         (t (load-chainer chainer-title :kb kb))))

(defun rulemacro-hash (&key verbose)
  (or *rmp-hash* 
      (setf *rmp-hash* (make-rulemacro-hash :verbose verbose))))

; Builds up a hash table of all the RuleMacroPredicates available in the KB.
; The keys are the instances of RuleMacroPredicates, and the values are the
;  associated expansion formulae.
(defun make-rulemacro-hash (&key verbose)
  (when verbose (format t "Building rulemacro-hash.~%"))
  (let ((hash (make-hash-table :size 300))
        (rmps (mapcar #'second 
                (retrieve-all '(data::isa ?x data::RuleMacroPredicate)))))  ;opt?  see ask
    (dolist (rmp rmps)
      (unless (equal rmp 'data::genls)          ; special-case this
        ;; 7/28 (TRH) added :raw  to avoid uninterned symbols
        (let ((expansion (caddar (retrieve-pattern (->data `(expansion ,rmp ?x)) :number :1))))
          (when expansion                       ; Not every rmp has an expansion
            (setf (gethash rmp hash) expansion)))))
    hash))

(defun get-all-macros-from-kb (&key (kb *kb*) (compile nil) (verbose nil))
  (when verbose (format t "Retrieving all macros from KB.~%"))
  (let ((axioms nil) (count 0) (max (hash-table-count (rulemacro-hash))))
    (maphash 
     #'(lambda (rmp formula)
         (let* ((arity (caddar (retrieve (->data `(arity ,rmp ?x)) :kb kb)))
                (new-axioms (retrieve-by-predicate kb rmp arity)))
           (when verbose (format t "~A/~A: ~A~%" (incf count) max rmp))
           (if compile 
             (setq axioms 
                   (append (mapcar #'(lambda (x) (expand x formula)) new-axioms)
                           axioms))
             (setq axioms (append new-axioms axioms)))))
     (rulemacro-hash))
    axioms))

(defun retrieve-by-predicate (kb pred arity)
  (if (and arity (integerp arity) (> arity 0))
    (mp:with-process-lock ((lock kb))
      (dbex:extension-of-predicate pred arity))))

; Returns t if the fact contains rule-macros that could be expanded.
(defun expandable? (fact &aux (x (car fact)))
  (if (listp x) 
    (or (expandable? x) (expandable? (cdr fact)))
    (gethash x (rulemacro-hash))))
  
; Expands an expression into an axiom, using RuleMacroPredicates.
; e.g. Turns (RelationAllInstance Color Bluejay Blue) into:
;            (implies (isa ?x Bluejay) (Color ?x Blue))
(defun expand (expr &optional (formula nil))
  (if (atom expr) expr
    (let ((args (mapcar #'expand (cdr expr))))
      (if (null formula) 
        (setq formula (gethash (car expr) (rulemacro-hash))))
      (if (null formula)
        (cons (car expr) args)
        (expand (sublis (make-exp-bindings args) formula))))))

(defun make-exp-bindings (args)
  (do ((i 1 (1+ i))
       (args args (cdr args))
       (bindings nil 
                 (cons (cons (intern 
                              (concatenate 'string "ARG" (princ-to-string i)) 
                              :keyword)
                             (car args))
                       bindings)))
      ((null args) bindings)))

;;;
;;; Testing
;;;

;;; To make the chainer the first time, call
;;; (fire:setup-rulemacros "Macros" :make-chainer t :verbose t)
;;; Be aware this can take ~30min for QRG-general.
;;;
;;; Once the Macros file exists (in the resources directory of the kb),
;;; then subsequent runs can just call (fire::setup-rulemacros "Macros")
;;; to load it.

(defun test-rulemacros ()
  (setup-rulemacros "Macros")
  (tell-it 'data::(isa Chilly-Willy Penguin))
  (query 'data::(significantColorOfObject Chilly-Willy ?x)))

;;; Note that in qrg-darpa, the query should be:
;;; (fire::query 'data::(objectHasColor Chilly-Willy ?x))
;;; since the CYC vocabulary has changed.

;;; End of Code