I've been rewriting the deftemplate code for MPS more or less from scratch... but I'll have to talk about that some other time. It's high time to focus on the defrule macro(s). I'll break this up into several posts and I'll start with the function for executing the RHS.
The MPS syntax (a subset of CLIPS') for defrule looks like this:
defrule-constructI'm quite far from having all of the above supported, but I've got enough to show how the function that executes the RHS of a rule works.
::= (defrule rule-name
::= template-pattern-CE ¦ assigned-pattern-CE ¦
not-CE ¦ and-CE ¦ or-CE ¦ test-CE ¦
exists-CE ¦ forall-CE
::= single-field-variable <- template-pattern-CE
not-CE ::= (not conditional-element)
and-CE ::= (and conditional-element+)
or-CE ::= (or conditional-element+)
test-CE ::= (test function-call)
exists-CE ::= (exists conditional-element+)
forall-CE ::= (forall conditional-element
::= (deftemplate-name single-field-LHS-slot*)
::= (slot-name constraint)
constraint ::= ? connected-constraint
::= single-constraint ¦
single-constraint & connected-constraint
single-constraint ¦ connected-constraint
::= term ¦ ~term
term ::= constant ¦ single-field-variable ¦
:function-call ¦ =function-call
The defrule macro works by expanding into a series of macro calls which handle more and more specific cases in the processing. The macro itself is quite simple
(defmacro defrule (name &body body)As you can see, it expands into two other macro-calls: compile-lhs and compile-rhs, where the first parses the conditional-elements and, in the process, creates two symbol-tables (fact-bindings and variable-bindings) with all of the variables it can find.
(let ((rhs (cdr (member '=> body)))
(lhs (ldiff body (member '=> body))))
(compile-lhs ,name ,@lhs)
(compile-rhs ,name ,@rhs))))
The second macro handles the RHS and looks like this:
(defmacro compile-rhs (name &body rhs)So, if we evaluate this:
(when (null rhs)
(setf rhs '(t)))
`(defun ,(make-sym "RHS/" name) (activation)
(let* ((token (activation-token activation))
,@(mapcar #'make-fact-binding (reverse fact-bindings))
,@(mapcar #'make-variable-binding (reverse variable-bindings)))
MPS> (defrule foobarit expands into this (among other things):
?foo <- (foo (bar ?bar) (baz 1))
(format t "~%~A ~A" ?foo ?bar))
(DEFUN RHS/FOOBAR (ACTIVATION)Most of the work is with figuring out how to assign values to each of the variables. I'm using a simple list as the structure for the tokens. WMEs (fact objects) are added in the order they appear in the list of conditional elements. Once all of the WMEs are bound, all of the variable-bindings are bound by using the automatically constructed accessor methods for those structs.
(LET* ((TOKEN (ACTIVATION-TOKEN ACTIVATION))
(?FOO (NTH 0 TOKEN))
(?BAR (DEFTEMPLATE/FOO-BAR ?FOO)))
(FORMAT T "~%~A ~A" ?FOO ?BAR)))
The actions in the RHS are simply spliced into the let* form at macro-expansion time which completes the function definition. It is then evaluated and stored with the rule's production node. Later, when that production node is left-activated, it creates an activation (with the WMEs and some additional meta-data like timestamps and such) and places it in the conflict-set. If that activation ever triggers a rule, it is passed as an argument to the RHS function.
Since I haven't got enough of "the rest" of MPS in place. We're going to have to mock an activation and call the function directly to see whether or not it works.
MPS> (rhs/foobar (make-activation :token (list (foo (bar 1) (baz 1)))))There's really not much more to say about the RHS so I'll stop here. The LHS is a bit more complicated and I hope that I can show some of that code soon.
#S(DEFTEMPLATE/FOO :BAR 1 :BAZ 1) 1