;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: pragmas.lsp
;;;;    System: FIRE
;;;;   Version: 1.0
;;;;    Author: Ken Forbus
;;;;   Created: December 30, 2000 15:31:55
;;;;   Purpose: Utilities for exploiting control information
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Saturday, January 20, 2001 at 20:33:07 by forbus
;;;; ---------------------------------------------------------------------------

(in-package :fire)

;;;; For the usual reasons, control information is expressed declaratively in the KB.
;;;; However, that requires a compilation process to gather it up, and efficient
;;;; methods to exploit it, so that it speeds up, rather than slows down, reasoning.
;;;; The utilities in this file support this.

;;;; The Binding Signature of a pattern is a summary of what is known.
;;;; It is a list of the same length as the pattern, but with the predicate
;;;; and arguments replaced by the keywords :KNOWN and :VAR, according to whether
;;;; or not they are (or contain) a variable. 
;;;; [N.B. I have a nagging feeling that a further distinction is needed between
;;;;  GAF's and :KNOWN, and with :HAS-VAR versus :VAR, but until we see some
;;;;  evidence for this, let's avoid it.]

(defun binding-signature (pattern)
  (when (listp pattern)
    (mapcar 'find-binding-status pattern)))

(defun find-binding-status (thing)
  (cond ((null thing) :known)
        ((ltre::variable? thing) :var)
        ((not (listp thing)) :known)
        ((eq (find-binding-status (car thing)) :var) :var)
        (t (find-binding-status (cdr thing)))))

;; The pragma for a predicate consists of a list of keyword/value pairs.
;; The following keywords are supported:
;; :backchain (:always, :never)
;; :functional (<list of args>) -- there could be more than one, cf. thermo tables.

(defun functional-args (pragma) (cadr (member :functional pragma)))

(defun backchain-status (pragma) (cadr (member :backchain pragma)))

(defun get-pragma (predicate &optional (kb *kb*))
   (let ((result (car (retrieve `(data::pragma ,predicate ?data)
                                :kb kb :number 1 :response '?data
                                :coverage :ground))))
     (if (listp result) (cdr result) nil)))

(defun skip-backchaining? (pragma) (eq (backchain-status pragma) :never))

(defun is-query-functional? (signature pragma)
  (let ((args-signature (cdr signature))
        (functional-args (functional-args pragma)))
    (when functional-args ;; might be cool
      (check-functional-args-signature 
       args-signature functional-args 1))))

(defun check-functional-args-signature (args functional-args arg-count)
  (cond ((null args) t) ;; passed every test
        ((member arg-count functional-args :test '=)
         (check-functional-args-signature (cdr args) functional-args (1+ arg-count)))
        ((eq (car args) :known) ;; input is known
         (check-functional-args-signature (cdr args) functional-args (1+ arg-count)))
        (t nil)))





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