(defun production-system (ruleset goal) (do* ((cycle-number 0 (1+ cycle-number)) (fired-rule (fire-rule cycle-number (conflict-resolution (select-conflict-set ruleset *working-memory*))) (fire-rule cycle-number (conflict-resolution (select-conflict-set ruleset *working-memory*))))) ((halted? fired-rule goal)) (write-inference-state cycle-number fired-rule) )) (defun halted? (fired-rule goal) (let ((halt? (member '(%%halt%%) *working-memory* :test #'equal)) (goal? (member goal *working-memory* :test #'equal))) (when (or (not fired-rule) halt? goal?) (format t "~%Rule Interpreter Halted") (cond ((not fired-rule) (format t "~%No Rules Fired")) (halt? (format t "~%Halt Signalled")) (goal? (format t "~%Goal ~a Achieved" goal))) (format t "~%Here are contents of working memory: ~%~a" *working-memory*) t))) (defun write-inference-state (cycle-number fired-rule) (format t "~%~a: rule ~a adds ~a. " cycle-number fired-rule (car (previous-fired-instantiations fired-rule)) (cycle-last-fired fired-rule)) (if *verbose* (mapc #'(lambda (crs) (if (not (equal (get crs 'before-apply) (get crs 'after-apply))) (format t "~% ~a effects.~% ~a -> ~a." crs (get crs 'before-apply) (get crs 'after-apply)))) *conflict-resolution-strategies*)))すべてのルールについて作業記憶と条件部がマッチする集合(競合集合: conflict set)を選びだし (select-conflict-set), conflict-resolution へ渡します.
(defun select-conflict-set (ruleset working-memory) (remove nil (mapcar #'(lambda (rule) (recognize-rule rule working-memory)) ruleset)))fire-ruleは,conflict-resolution で選ばれたひとつのルールに対 して,そのルールの instantiation 情報を *working-memory* に追加します.
(defun fire-rule (cycle-number rule) (when rule (let ((insts (consequent-instantiation rule))) (setf *working-memory* (union insts *working-memory* :test #'equal)) (setf (previous-fired-instantiations rule) (union insts (previous-fired-instantiations rule) :test #'equal)) (setf (get rule 'cycle-last-fired) cycle-number) rule)))次に,次の推論サイクルでの競合解消戦略 (fireable-rules) で利用するため にそのinstantiation 情報(条件部の変数にバインドされた環境において評価 された行動部パターンのこと)を previous-fired-instantiations 属性に付 加します.さらに,次の競合解消戦略 (find-least-recently-fired-rules) に おいて利用するために,その時の推論サイクルの番号をそのルールの cycle-last-fired 属性に保存します. 推論サイクルが終了するのは (halted?) ,作業記憶のなかに,(%%halt%%) が入っていた場合,goal が入っていた場合, fire 可能なルールがない場合の 3つの場合です. 各サイクルごとに作業記憶のなかに何が追加されたかを表示します. この際 *verbose* が nil でなければ,そのサイクルでの競合解消状況を表示 します. ルールの認識 recognize-ruleでは,条件部が作業記憶とマッチしたルール について,行動部の記述内に現れる変数すべてを条件部でマッチしたもの に置き換えるということを行ない,置き換えた行動部を,そのルールの instantiation属性に蓄えます.
(defun recognize-rule (rule memory) (let ((environment (match-antecedent (antecedent rule) memory))) (when (not (fail environment)) (setf (antecedent-instantiations rule) (instantiate-rule (antecedent rule) environment)) (setf (consequent-instantiation rule) (instantiate-rule (consequent rule) environment)) rule))) (defun instantiate-rule (rule-consequent environment) (cond ((null rule-consequent) nil) ((atom rule-consequent) (value-of rule-consequent environment)) (t (cons (instantiate-rule (car rule-consequent) environment) (instantiate-rule (cdr rule-consequent) environment))))) (defun value-of (a b) (let ((v (lookup a b))) (if v v a)))