Handling defrules in MPS, executing the RHS

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-construct
    ::= (defrule rule-name
          conditional-element*
          =>
          expression*)

  conditional-element
    ::= template-pattern-CE ¦ assigned-pattern-CE ¦
        not-CE ¦ and-CE ¦ or-CE ¦ test-CE ¦
        exists-CE ¦ forall-CE

  assigned-pattern-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
                         conditional-element+)

  template-pattern-CE
    ::= (deftemplate-name single-field-LHS-slot*)

  single-field-LHS-slot
    ::= (slot-name constraint)

  constraint ::= ?  connected-constraint


  connected-constraint
    ::= single-constraint ¦
        single-constraint & connected-constraint
        single-constraint ¦ connected-constraint

  single-constraint
    ::= term ¦ ~term

  term       ::= constant ¦ single-field-variable ¦
                 :function-call ¦ =function-call

  single-field-variable
    ::= ?variable-symbol

I'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.

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)
  (let ((rhs (cdr (member '=> body)))
        (lhs (ldiff body (member '=> body))))
    `(progn
       (compile-lhs ,name ,@lhs)
       (compile-rhs ,name ,@rhs))))

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.

The second macro handles the RHS and looks like this:

(defmacro compile-rhs (name &body rhs)
  (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)))
       ,@rhs)))

So, if we evaluate this:

MPS> (defrule foobar
       ?foo <- (foo (bar ?bar) (baz 1))
        =>
       (format t "~%~A ~A" ?foo ?bar))

it expands into this (among other things):

(DEFUN RHS/FOOBAR (ACTIVATION)
  (LET* ((TOKEN (ACTIVATION-TOKEN ACTIVATION))
         (?FOO (NTH 0 TOKEN))
         (?BAR (DEFTEMPLATE/FOO-BAR ?FOO)))
    (FORMAT T "~%~A ~A" ?FOO ?BAR)))

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.

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)))))
#S(DEFTEMPLATE/FOO :BAR 1 :BAZ 1) 1
NIL
MPS>

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.