diff --git a/II/mps.lisp b/II/mps.lisp index 08a92d7..be1e68f 100644 --- a/II/mps.lisp +++ b/II/mps.lisp @@ -18,19 +18,17 @@ (:use :cl) (:export "=>" ; symbols - :assert-facts ; public API - :retract-facts - :run ; TBD - - :defrule - - :agenda + :agenda ; public API + :assert-facts :clear + :deffacts + :defrule :facts + :halt :modify-fact :reset - - :deffacts)) + :retract-facts + :run)) (in-package :MPS) ;; Helper methods @@ -202,9 +200,10 @@ (defun conflict-set () (let ((result '())) - (maphash #'(lambda (k v) - (declare (ignore k)) - (push v result)) + (maphash #'(lambda (salience activations) + (declare (ignore salience)) + (dolist (activation activations) + (push activation result))) *activations*) result)) @@ -239,6 +238,28 @@ t) +(let ((limit -1)) + (defun run (&optional (n -1)) + "Run" + (setf limit n) + (do* ((curr-agenda (agenda) (agenda)) + (execution-count 0 (+ execution-count 1))) + ((or (eq limit 0) + (eq (length curr-agenda) 0)) execution-count) + (decf limit) + (let* ((activation (first curr-agenda)) + (token (activation-token activation)) + (timestamp (activation-timestamp activation)) + (rule (activation-rule activation)) + (salience (activation-salience activation)) + (action (sym (activation-rule activation) "-rhs"))) + (funcall action token) + (store-activation '- token timestamp rule salience)))) + + (defun halt () + "Halt" + (setf limit 0))) + ;; These macros are the building blocks of the MPS rule language and they ;; expand into a bunch of defuns that represent the Rete network of the rules.