;; Patrick Connelly
;; California University of Pennsylvania
;; The SUPACOND
;; proper description here: http://darkstar.freeshell.net/hacks.html
;; 
;; TODO: [-]add pp-pred and pp-cons for pretty-printing the predicate
;;	    and consequences of an sc
;;	 [-]make scond-resort generic by
;;	    adding a slot for a sorting function...  in this way the
;;	    sc and scond classes could be inherited and new sorting
;;	    criteria could be described
(defparameter *default-scond-resort-freq* 10
  "This defines the default number of times a scond is evaluated before being resorted")

(defclass sc ()
  ((predicate :initform nil :initarg :pred :type list :accessor sc-pred)
   (consequences :initform nil :initarg :conseq :type list :accessor sc-cons)
   (truth-count :initform 0 :type integer :accessor sc-count)))

(defclass scond ()
  ((sc-list :initform nil :initarg :sc-list :type list :accessor sc-list)
   (iter-count :initform 0 :type integer :accessor scond-iter)
   (resort-freq :initform *default-scond-resort-freq* :type integer :accessor scond-resort-freq)
   (reset-on-sort :initform nil :initarg :reset-on-sort :accessor reset-on-sort)))

;; returns scond object s.t. each element of body is an sc object in the scond's sc-list
;; and resort-freq is *default-scond-resort-freq*
(defmacro supacond (&body body)
  (let ((g (gensym))
	(temp (make-instance 'scond)))
    `(make-instance 'scond
		    :sc-list
		    (mapcar #'(lambda (x)
				(eval `(sc-maker ,x)))
			    ',body))))

;; returns a new sc object with evaluation of (car pc) for a predicate
;; and evaluation of all the (rest pc) as a consequent action
(defmacro sc-maker (pc)
  (make-instance 'sc
		 :pred #'(lambda () (eval `,(car `,pc)))
		 :conseq #'(lambda () (eval `(progn ,@(cdr `,pc))))))

;; evaluates the predicates of each sc object in the scond's
;; sc-list until one is true.  It incremeents that sc's count
;; and returns the result of evaluating the sc's consequent
(defmethod scond-eval ((s scond))
  (scond-iter-inc s)
  (if (= 0 (mod (scond-iter s) (scond-resort-freq s)))
      (scond-resort s)
      (scond-reset-sc-counts s))
  (dolist (a (sc-list s))
    (when (funcall (sc-pred a))
      (sc-inc a)
      (return (funcall (sc-cons a))))))

(defmethod scond-reset-sc-counts ((s scond))
  (dolist (sc (sc-list s))
    (setf (sc-count sc) 0)))

(defmethod scond-resort ((s scond))
  (setf (sc-list s)
	(sort (sc-list s)
	      #'(lambda (v1 v2)
		  (> (sc-count v1) (sc-count v2))))))

(defmethod scond-iter-inc ((s scond))
  (incf (scond-iter s)))

(defmethod sc-inc ((s sc))
  (incf (sc-count s)))