2.5 ���_�G���W��

���_�G���W�����������������������������D

(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*)))

�����������[���������������L�������������}�b�`�����W���i�����W��: conflict set�j���I������ (select-conflict-set)�C conflict-resolution ���n�������D

(defun select-conflict-set (ruleset working-memory)
  (remove
   nil
   (mapcar
    #'(lambda (rule)
        (recognize-rule rule working-memory))
    ruleset)))

fire-rule���Cconflict-resolution ���I�����������������[������ �����C�������[���� instantiation ������ *working-memory* �������������D

(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)))

�����C�������_�T�C�N������������������ (fireable-rules) �����p�������� ������instantiation �����i���������������o�C���h�������������������]�� �������s�����p�^�[���������j�� previous-fired-instantiations �������t ���������D�������C���������������� (find-least-recently-fired-rules) �� ���������p�����������C�����������_�T�C�N�����������������[���� cycle-last-fired �����������������D ���_�T�C�N�����I���������� (halted?) �C�����L�����������C(%%halt%%) �����������������Cgoal �����������������C fire ���\�����[�������������� �R�������������D �e�T�C�N�������������L�����������������������������\���������D ������ *verbose* �� nil �����������C�����T�C�N���������������������\�� �������D ���[�����F�� recognize-rule�����C�������������L�����}�b�`�������[�� ���������C�s�������L�q�������������������������������}�b�`�������� ���u���������������������s�����C�u���������s�������C�������[���� instantiation�������~�������D

(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)))