;; -*- Mode: Lisp; -*- 

;;;; JTRE definitions  
;;;; Last edited 1/29/93, by KDF

;;; Copyright (c) 1989 -- 1992 Kenneth D. Forbus, Northwestern University,
;;; Johan de Kleer and Xerox Corporation.
;;; All rights reserved.

;;; See the file legal.txt for a paragraph stating scope of permission
;;; and disclaimer of warranty.  The above copyright notice and that
;;; paragraph must be included in any separate copy of this file.

(in-package :cl-user) 

(defstruct (jtre (:print-function jtre-printer))
  "JTMS-based Tiny Rule Engine definition."
  title                   ; Pretty name
  jtms                    ; Pointer to its JTMS
  (dbclass-table nil)     ; Table of dbclasses
  (datum-counter 0)       ; Unique ID for asserts
  (rule-counter 0)        ; Unique ID for rules
  (debugging nil)         ; If non-nil, show basic operations
  (queue nil)             ; Rule queue
  (rules-run 0))          ; Statistic

(defun jtre-printer (j st ignore)
  (declare (ignore ignore))
  (format st "<JTRE: ~A>" (jtre-title j)))

(defvar *jtre* nil "Default JTRE.")

(defmacro with-jtre (jtre &rest forms)
  "Within extent, use <jtre> as default rule engine."
  `(let ((*jtre* ,jtre)) ,@ forms))

(defun in-jtre (jtre)
  "Reset default rule engine to <jtre>."
  (setq *jtre* jtre))

(defmacro debugging-jtre (msg &rest args)
  "When debugging is turned on, print message."
  `(when (jtre-debugging *jtre*) (format t ,msg  ,@args)))

(defun create-jtre (title &key debugging)
 "Create new JTRE with given title and debugging flag."
 (let ((j (make-jtre
           :title title 
           :jtms (create-jtms (list :jtms-OF title) 
                              :node-string 'view-node)
           :dbclass-table (make-hash-table :test #'eq)
           :debugging debugging)))
   (change-jtms (jtre-jtms j)
                :enqueue-procedure
                #'(lambda (rule) (enqueue rule j)))
   j))

(defun change-jtre (jtre &key (debugging :NADA))
  "Change debugging flag on given JTRE."
  (unless (eq debugging :NADA)
          (setf (jtre-debugging jtre) debugging)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Running JTRE

(defun uassert! (fact &optional (just 'user))
  "Assert user fact and run rules."
  (assert! fact just) ;; Do internal operation
  (run-rules *jtre*))        ;; Run the rules

(defun uassume! (fact reason) ;; Similar to UASSERT!
  "Assume user fact and run rules."
  (assume! fact reason *jtre*)
  (run-rules *jtre*))

(defun run-forms (forms &optional (*jtre* *jtre*))
  "Evaluate <forms> within given JTRE, then run rules."
  (dolist (form forms) (eval form) (run-rules *jtre*)))

(defun run (&optional (*jtre* *jtre*)) ;; Toplevel driver function
    (format t "~%>>")
    (do ((form (read) (read)))
        ((member form '(quit stop exit abort)) nil)
        (format t "~%~A" (eval form))
        (run-rules)
        (format t "~%>>")))

(defun show (&optional (*jtre* *jtre*) (stream *standard-output*))
  "Show data and rules within JTRE."
  (show-data *jtre* stream) (show-rules *jtre* stream))