;; ШАБЛОНЫ
;; Литерал - атомарное высказывание,
(deftemplate literal (field id (type INTEGER))
(field atom (type SYMBOL))
(multifield support (type INTEGER) (default -1))
| )
Условие является импликацией в форме
;; "Р имплицирует Q", где "P" является левой частью правила
;; (left-hand side = Ihs),
;; "Q" - правой частью
;; (right-hand side = rhs).
(deftemplate conditional
(field Id (type INTEGER))
(multifield Ihs (type SYMBOL))
(multifield rhs (type SYMBOL)) )
;; Нам понадобится индекс в рабочей памяти, чтобы
;; можно было присваивать идентификаторы новым
;; производным высказываниям, (deftemplate index
(field no (type INTEGER)) )
;; Исходная модель мира. (deffacts model
(conditional (id 0) (Ihs P) (rhs Q);
(literal (id 1) (atom P)) )
;; ПРАВИЛА
;; Присвоить значение индекса очередному идентификатору,
(defrule init
?F <- (initial-fact)
(literal (id ?N))
(not (literal (id ?M&:{> ?M ?N)))) =>
(assert (index (no (+ ?N 1))))
(retract ?F) )
;; Применить правило modus ponens, чтобы можно было
;; вывести "Q" из "Р" и "Р имплицирует Q", формируя
;; указатели на "Р" и "Р имплицирует Q" в попе
;; support литерала "Q". (defrule mp ?I <- (index (no ?N))
(conditional (id ?C) (Ihs $?X) (rhs $?Y)) (literal (id ?A)
(atom $?X)) (not (literal (atom $?Y)))
(assert (literal (id ?N) (atom $?Y) (support ?C ?A)))
(modify ?I (no (+ ?N 1)))
Эта примитивная программа имеет дело только с условными выражениями и атомами. Например, нельзя, используя правило modus fallens (см.главу 8), вывести "не Р" из "Р имплицирует Q" и "не Q".