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.

CLIPS is not a Lisp

In a recent thread on JBoss Drools' Rules Users mailing list, Mark Proctor writes:

... The Drools DRL language itself was designed as a more intuitive and less verbose language, this becomes increasinly important as you start to add more complex syntax which becomes harder to read with a lisp approach. I think most people in here would agree that the Drools DRL approach is an improvement over the lisp approach of clips/jess - apart from the die hard lisp fans.

I might be a die hard Lisp fan, but if you ask me, the problem is not that CLIPS (and Jess) are Lisp-like it's that they are Lisp-like.

CLIPS doesn't use a Lisp approach. It might look that way, but the similarities are only skin-deep. CLIPS lack one of the most fundamental requirements for being Lispy, namely, code as data. It lacks other things as well, but given that capacity (or in other words to be able to provide a higher level syntactical abstraction on top of CLIPS) there would be nothing wrong with CLIPS syntax that couldn't be fixed with CLIPS syntax. Yes. I know about build and eval but they'll only take you so far. It's not that I'm unhappy with CLIPS, but I honestly believe a Lisp-based CLIPS would be so much better.

My apologies to Mark. This rant has nothing to do with JBoss Drools. It's just that his post had the magic words in it ;-)

Updating my Common Lisp environment

I've been using LispBox since Peter first announced it. At home I've got both a Mac OS X version (using OpenMCL) as well as a Windows version (using CLISP). I've also tried Lisp In A Box and Ready Lisp (using SBCL).

LispBox has worked great for me but it's time to take off the training wheels. So I've uninstalled all of my ready-to-go Lisp kits, downloaded a fresh snapshot of SLIME and installed a copy of Aquamacs. One day, maybe, I'll be enough hacker to compile Emacs from source but that's going to have to wait a while...and Aquamacs boasts about being so much better in a direct comparison so I've decided to give it a try. I've yet to become familiar with Emacs' way of handling the clipboard anyway so this seems a perfect fit at the moment (Aquamacs allows you to use the "usual" Mac shortcuts).

Installations were a lot easier than I thought. The only problem I ran into was actually that it took some time to get Finder to show the .emacs.d folder (I had to use the menu option Go to folder...). I've already got several CL implementations running (ECL, Clozure and SBCL) on my Mac so now I just have to figure out either how to get SLIME to connect to several Lisps or how to customize Aquamacs so that I can do M-x ECL to start SLIME with ECL.

Structuring data via behavioural synthesis

I am one of the those who have been (and some still are, I guess) waiting for Geoff Wozniak to post a link to his thesis, Structuring data via behavioural synthesis, on his blog Exploring Lisp. To my surprise, it turns out that someone at the University of Western Ontario has published it already, only "bad" thing with that is of course that now I want to see the code even more.

Working out some kinks

I've been a student of Lisp(s) for roughly five years now. Unfortunately, sometimes, pretty simple bugs show up and bite me. I'm a bit embarrassed to say this but... I haven't written anything about MPS for a while because I've had a problem with the proof-of-concept code. Or, so I thought. It turned out that the agenda function used mapcan instead of mapcar. Funny (well...) thing is that since I thought it used mapcar it took me quite a while to find it.

MPS inference engine, the rest of the implementation

In the last post I mentioned a few of the design choices I've made for the Rete Network implementation. The rest of the engine is quite straight forward and simple. There's really not much to talk about but I'll show some code anyway ;-).

Another thing though, and a bit more interesting really, is that I have been thinking about whether or not I should try to stay true to CLIPS' behaviour and functionality in the misc engine functions as well.

For example, the agenda function currently returns a list of all activations on the agenda and CLIPS prints them but returns no value. Similarly there's facts which behaves like get-fact-list instead. Used at the REPL there's little difference in what the user sees but the reason I've made them different is because then I can write other functions on top of them.

Ok. As promised, some code. Here is the run function (which uses agenda):

|(defun run (&optional (limit -1))
|  (do* ((curr-agenda (agenda) (agenda))
|        (execution-count 0 (+ execution-count 1))
|        (limit limit (- limit 1)))
|       ((or (eq limit 0)
|            (= (length curr-agenda) 0)) execution-count)
|    (let* ((activation (first curr-agenda))
|           (rhs-func (make-sym "RHS-" (string (activation-rule activation))))
|           (prod-mem (make-sym "PRODUCTION-" (string (activation-rule activation)) "-MEMORY")))
|      (funcall rhs-func activation)
|      (store '- activation prod-mem))))

and here is the assert function (I'm shadowing the built-in assert function, still accessible as cl:assert though):

|(defun assert (&rest facts)
|  (incf timestamp)
|  (dolist (fact facts)
|    (store '+ fact 'working-memory)
|    (mapcar #'(lambda (node) (funcall node '+ fact timestamp))
|            (gethash (type-of fact) (gethash 'root rete-network)))))

I hope that they are at least somewhat readable to others.

I've now finished the functions that make up the inference engine implementation. And it works... as long as you manually divide your program into alpha, beta and production nodes and connect them properly in the Rete Network ;-)

MPS inference engine, the Rete Network implementation

It's difficult to talk about the MPS defrule macro and the code it expands to without first explaining the environment in which it is meant to run. So I'll try to explain and describe my current thoughts and ideas that make up the design of the MPS inference engine in this and following posts.

The engine is made up of some I/O functions (assert and retract), the Rete Network, a Conflict Resolver and an Execution Engine. The Rete Network is the most central part of the whole thing so I'll start there.

It is basically implemented within a hash-table. This is the simplest possible representation of a Rete Network that I can think of. There are, of course, a few helper functions to abstract away some of the book keeping details of this design choice. During rule compilation there are functions for adding a node/memory and connecting nodes/memories with each other and at run time there are functions to propagate facts/tokens, access contents of and store facts/tokens in memory.

A processing node (for example an alpha node) is implemented as a function and is stored in the hash-table as well. A very simple LHS construct like:

|(defrule foo
|  (bar (baz ?baz&:(> ?baz 10)))
|  =>)

would be represented in the Rete Network by the following function:

|(defun bar-baz->-10 (key fact timestamp)
|  (when (> (deftemplate/bar-baz fact) 10)
|    (store key fact 'bar-baz->-10-memory)
|    (propagate key fact timestamp 'bar-baz->-10)))

A join node is represented by two functions (one for left and one for right activation) and is slightly more complex (but not much). If we change the LHS to:

|(defrule foo
|  (bar-1 (baz ?baz))
|  (bar-2 (baz ?baz))
|  =>)

we would have to create a join node for joining facts on the ?baz variable. It would look something like this:

|(let ((left-memory  'bind-bar-1-memory)
|      (right-memory 'bind-bar-2-memory))
|  (defun join-bar-1-baz-and-bar-2-baz-left (key token timestamp)
|    (dolist (fact (contents-of right-memory))
|      (when (eq (bar-1-baz (nth 0 token))
|                (bar-2-baz fact))
|        (store key (append token (list fact)) 'join-bar-1-baz-and-bar-2-baz-memory)
|        (propagate key (append token (list fact)) timestamp 'join-bar-1-baz-and-bar-2-baz))))
|
|  (defun join-bar-1-baz-and-bar-2-baz-right (key fact timestamp)
|    (dolist (token (contents-of left-memory))
|      (when (eq (bar-1-baz (nth 0 token))
|                (bar-2-baz fact))
|        (store key (append token (list fact)) 'join-bar-1-baz-and-bar-2-baz-memory)
|        (propagate key (append token (list fact)) timestamp 'join-bar-1-baz-and-bar-2-baz)))))

As you can see variables are expanded into "positions" everywhere in the functions. Variables are, however, available and bound in the execution context of the production node's RHS function.

There are some more bits and pieces that are good to know. The root node, for example, is a hash-table. Each deftemplate-type is a key and the value contains a list of alpha nodes.

Compilation consists of (apart from expanding the rule's LHS into a number of functions) a series of calls to add-to-root and connect-nodes. Since each node is responsible for propagating as well as storing facts/tokens in memory we can connect the processing nodes to each other directly. The example above would be compiled with:

|(add-to-root 'bar-1 #'bind-bar-1) ; This might not be necessary! We should
|(add-to-root 'bar-2 #'bind-bar-2) ; be able to connect directly to the join.
|(connect-nodes 'bind-bar-1 #'join-bar-1-baz-and-bar-2-baz-left)
|(connect-nodes 'bind-bar-2 #'join-bar-1-baz-and-bar-2-baz-right)
|(connect-nodes 'join-bar-1-baz-and-bar-2-baz #'production-foo)

This is all theory, though. I don't actually have all of the defrule macro in place so the final version might very well expand into something different. But I hope this conveys the general idea of the Rete Network implementation.

Handling deftemplates in MPS

There are three parts to my MPS (Minimal Production System) experiment, the "engine" itself and the deftemplate and defrule macros. So far, I've spent most of my time on the deftemplate macro. It turned out to be a bit trickier than I thought to implement. Mostly because I was stuck thinking about too complex macro expansions (which I never got to work).

Here is the syntax as BNF (well, sort of[1]):

|  deftemplate-construct
|    ::= (deftemplate deftemplate-name
|                     [comment]
|                     single-slot-definition*)
|
|  single-slot-definition
|    ::= (slot slot-name [default-attribute])
|
|  default-attribute
|    ::= (default ?NONE | expression) |
|        (default-dynamic expression)

It is a subset of CLIPS' deftemplate syntax. There are no multislots and no constraint-attributes for slots (types, ranges and such). But, apart from that, it is more or less the same[2]. And here's how it works:

|; SLIME 2007-03-14
|;;;; Compile file / [...] /mps. ...
|CL-USER> (in-package :mps)
|#[Package "MPS"]
|MPS> (deftemplate foo
|       (slot a-slot)
|       (slot a-default-slot (default 1))
|       (slot required-slot (default ?NONE)))
|FOO
|MPS> (foo)
|
|The slot: REQUIRED-SLOT in deftemplate: FOO requires an explicit value.
|   [Condition of type SIMPLE-ERROR]
|
|Restarts:
| 0: [ABORT] Return to SLIME's top level.
| 1: [ABORT-BREAK] Reset this process
| 2: [ABORT] Kill this process
|
|Invoking restart: Return to SLIME's top level.
|; Evaluation aborted
|MPS> (foo (required-slot 1))
|#S(DEFTEMPLATE/FOO :A-SLOT NIL :A-DEFAULT-SLOT 1 :REQUIRED-SLOT 1)
|MPS> (deftemplate bar
|       (slot default-gensym (default (gensym)))
|       (slot dynamic-gensym (default-dynamic (gensym))))
|BAR
|MPS> (bar)
|#S(DEFTEMPLATE/BAR :DEFAULT-GENSYM #:G31 :DYNAMIC-GENSYM #:G40)
|MPS> (bar)
|#S(DEFTEMPLATE/BAR :DEFAULT-GENSYM #:G31 :DYNAMIC-GENSYM #:G41)
|MPS>

The macro expands into a defstruct (deftemplate/foo) and another defmacro (foo) that is used as a constructor for the template. The reason it is a macro and not a regular function is because a function's arguments are evaluated whilst a macro's is not. And since there's no function named a-slot or a-default-slot etc. So we'd be thrown into the debugger if we tried to evaluate something like (foo (a-slot 1)).

Here's the macroexpansion of a simple template:

|MPS> (pprint (macroexpand-1 '(deftemplate foo
|                               (slot a)
|                               (slot b (default 1)))))
|
|(PROGN (DEFSTRUCT DEFTEMPLATE/FOO "" (A NIL) (B 1))
|       (DEFMACRO FOO (&REST SLOTS)
|         ""
|         (CALL-DEFSTRUCT-CONSTRUCTOR 'DEFTEMPLATE/FOO SLOTS)))
|; No value
|MPS>

Most of the code is spent checking that the template follows the syntax described in the BNF. The expansion itself is rather simple, almost trivial (it is the last progn below).

|(defmacro deftemplate (deftemplate-name &body body)
|  "
|  The deftemplate construct is used to create a template which can then
|  be used by non-ordered facts to access fields of the fact by name.
|
|  Examples:
|  (deftemplate object
|    (slot id (default-dynamic (gensym)))
|    (slot name (default ?NONE))           ; Makes name a required field
|    (slot age))
|  "
|
|  (macrolet ((signal-deftemplate-error (msg &rest args)
|               `(error (concatenate 'string "~&The deftemplate ~A contains at least one invalid slot-definition: ~S." ,msg)
|                       ,@args)))
|    (let ((comment "")
|          (defstruct-name (intern (concatenate 'string "DEFTEMPLATE/" (string deftemplate-name))))
|          (defstruct-slots '()))
|
|      ;; Extract the documentation string
|      (when (stringp (car body))
|        (setf comment (car body))
|        (setf body (cdr body)))
|
|      ;; Check syntax and extract slot-specifiers
|      (dolist (slot body)
|        (let* ((slot-name (cadr slot))
|               (curr-defstruct-slot `(,slot-name nil)))
|          (unless (eq (car slot) 'slot)
|            (signal-deftemplate-error "~&Expected SLOT instead of ~A."
|                                      deftemplate-name slot (car slot)))
|
|          (when (> (length slot) 2)
|            (dolist (default-attribute (cddr slot))
|              (unless (consp default-attribute)
|                (signal-deftemplate-error "~&Expected (default ?NONE|expression) or (default-dynamic expression) instead of ~A."
|                                          deftemplate-name slot default-attribute))
|              (unless (or (eq (car default-attribute) 'default)
|                          (eq (car default-attribute) 'default-dynamic))
|                (signal-deftemplate-error "~&Expected DEFAULT or DEFAULT-DYNAMIC instead of: ~A."
|                                          deftemplate-name slot (car default-attribute)))
|              (if (eq (car default-attribute) 'default)
|                  (if (eq (cadr default-attribute) '?NONE)
|                      (setf curr-defstruct-slot `(,slot-name (required ',slot-name ',deftemplate-name)))
|                      (setf curr-defstruct-slot `(,slot-name ',(eval (cadr default-attribute)))))
|                  (setf curr-defstruct-slot `(,slot-name ,(cadr default-attribute))))))
|
|          (setf defstruct-slots (append defstruct-slots (list curr-defstruct-slot)))))
|
|      `(progn
|         (defstruct ,defstruct-name
|           ,comment
|           ,@defstruct-slots)
|
|         (defmacro ,deftemplate-name (&rest slots)
|           ,comment
|           (call-defstruct-constructor ',defstruct-name slots))))))

and here are the functions used as helpers:

|(defun required (slot-name deftemplate-name)
|  (error "~&The slot: ~A in deftemplate: ~A requires an explicit value." slot-name deftemplate-name))
|
|(defun as-keyword (sym)
|  (intern (string-upcase sym) :keyword))
|
|(defun call-defstruct-constructor (defstruct-name &rest slots)
|  (let ((constructor (intern (concatenate 'string "MAKE-" (string defstruct-name)))))
|    (apply constructor (mapcan #'(lambda (slot)
|                                   `(,(as-keyword (car slot)) ,(cadr slot)))
|                               (car slots)))))

I should probably try to write a macro to abstract away all those (intern (concatenate 'string ...)) calls but otherwise, that's about it for deftemplate. Next up is getting all of the defrule construct working (which feels like a much tougher task).

[1] I hate that I still haven't found a good way of sharing code using Blogger. Tips and pointers are very welcome!

[2] The default and default-dynamic attributes in CLIPS take a variable number of expressions (at least according to the BNF found in the CLIPS Basic Programming Guide, Appendix H). I assume it assigns the value of the last as the default but I haven't tried. Anyway, if you want to evaluate several expressions in that place you're going to have to wrap it explicitly in a progn (effectively making it one expression).

A Minimal Production System

I've been experimenting a bit with bits and pieces of a production system in Common Lisp for a few days now. It all started as a fun exercise in Common Lisp macrology (the idea was to convert CLIPS syntax into executable Common Lisp code) but since things have fallen into place so neatly. I thought maybe it would be worth implementing parts of CLIPS syntax and functionality. So now, the only question is: which parts to implement?

I'm not going to do anything about data types and built-in functions. I'll add support for ?variables but that's about it (no multifields and no globals) and as far as constructs go I'll manage with defrule and deftemplate (no implied/ordered facts). If it doesn't turn out to be too difficult I'll try to include connected constraints in defrule but I won't bother with slot constraints in deftemplates (types and such). I'm hoping to include all CEs but it depends on how hairy it gets.

So. What have I missed? Is there something unnecessary on the list?

[Update 2008-08-03]: Hm. I guess I forgot about a bunch of engine commands. So here goes. Assert and retract seem stupid to leave out, as does run. I'll probably be annoyed not to have facts so I guess that's in as well. Load, clear, reset and agenda feel necessary but I think I'll only work with one conflict resolution strategy (depth) though.

Common Lisp Reasoner

I just found the SourceForge project Common Lisp Reasoner. It's a CLOS extension for AI applications like scheduling and diagnosis. I haven't had time to check it out, but it looks interesting. I wonder if it plays nicely with other CLOS extensions, like the production system Lisa for example.

Roots of Lisp II

Since I wrote the post about Paul Graham's article Roots of Lisp about two weeks ago I've been searching for similar efforts to read, learn from and basically - steal. And I've got to say. There are some pretty impressive stuff out there.

Ur-Scheme is a self-hosting partial implementation of R5RS that runs on Intel x86 Linux.

The 90 minute Scheme to C compiler which is a presentation of how to write your own Scheme compiler (it takes 90 minutes to present, not to write the compiler).

The icbins Lisp to C compiler and interpreter in 10 pages of C by Darius Bacon. He's written an even smaller one (6 pages) but which doesn't include the interpreter.

Out of the three I suspect that icbins is what comes closest to answering my question (what kind of boiler-plate code would be required to support such an implementation) though I believe that it is written to support more (probably much more) than what is described in Graham's article or in the Lisp 1.5 Programmer's Manual.

Roots of Lisp

The first time I read Paul Graham's article The Roots of Lisp was a couple of years ago. I remember thinking that it's cool that Lisp can be defined in itself using only seven functions (quote, atom, eq, cons, car, cdr and cond) but it's even more interesting to think about what kind of boiler-plate code would be required to support such an implementation. I mean, it's not like McCarthy and the others had a high-level language available when they wrote the first Lisp interpreter.

Yesterday I stumbled on the Software Preservation Group's History of Lisp-page. It contains a lot of information about those first steps in Lisp history. One of many interesting things to read about is Pascal Bourguignon's work on getting the first Lisp compiler (written in 1962) running on an IBM 7090 emulator.

Whilst Pascal's project is indeed impressive work and interesting in many ways it would be even more interesting to do something similar using GCC in order to get a minimal Lisp interpreter. And I mean really minimal. For instance, complicated things to parse such as (foo bar baz) won't be supported, a minimal parser would require you to write (foo . (bar . (baz . ()))). But since that's just the first layer in the implementation we could write a new reader using our minimal Lisp. One that would support, among other things, parsing lists as we'd usually write them.

I wonder if the same seven functions will be sufficient to pull that off or if it turns out to require more things. Unfortunately I haven't got the time to find out. I'll just keep reading the available historical material and keep hoping for someone else to step up for this experiment ;-)

LISA, Multislots and thoughts about Pattern matching

LISA has no multislots. That's just the way it is. You can add a list to a slot, but you have to match it as-is unless you provide a custom test-function.

About a week ago, Pedro Kröger announced on the Lisa Users mailing list that he was converting the Zebra puzzle from CLIPS to LISA. The rule syntax is so similar between the engines that it ought to have been a quite straightforward and simple exercise. But, since the CLIPS solution uses implied deftemplates (which are implemented as multislots) the LISA program wouldn't work.

This, and many other situations like it, has made me wonder about why nested fact structures aren't supported. Matching, on any level in a nested list, is actually described in Forgy's thesis (from 1979) but hasn't, for some reason, been implemented in most rule engines. Probably because it's faster to only allow flat structures.

The Rete implementation described in the thesis constructs an awful lot of nodes but I'm not sure you need all of them. A rule compiler ought to be able to figure out which part of a structure to test without doing too many feature-tests ("is the second subelement a list of 3 subelements" etc).

Another Clips and Lisa comparison

I spent this evening with Emacs, CLisp and Lisa. I wanted to get this piece of Clips code working:

|CLIPS> (deftemplate movie
|  (multislot title))
|CLIPS> (deffacts movies
|  (movie (title "A" "B" "C"))
|  (movie (title "B" "C" "D"))
|  (movie (title "C" "D" "E")))
|CLIPS> (defrule chain
|  ?m1 <- (movie (title $? $?link&:(> (length$ $?link) 0)))
|  ?m2 <- (movie (title $?link $?))
|  (test (neq ?m2 ?m1)) ; Avoid infinite chains because of
|                       ; movie titles like "Liar Liar".
| =>
|  (printout t (fact-slot-value ?m1 title) " " (fact-slot-value ?m2 title) crlf))
|CLIPS> (reset)
|==> Activation 0      chain: f-1,f-2
|==> Activation 0      chain: f-2,f-3
|==> Activation 0      chain: f-1,f-3
|CLIPS> (run)
|("A" "B" "C") ("C" "D" "E")
|("B" "C" "D") ("C" "D" "E")
|("A" "B" "C") ("B" "C" "D")

Note how elegantly $?link matches any number of elements in a multislot.

Unfortunately, there are no multislots in Lisa. But, you're allowed to add a list (or even a list of lists) to a slot. Only thing is that you either have to match it as-is or provide your own predicate function to perform whatever test you need done. Here's what I came up with:

|LISA-USER> (deftemplate movie ()
|             (slot title))
|#[STANDARD-CLASS MOVIE]
|LISA-USER> (deffacts movies ()
|             (movie (title '("A" "B" "C")))
|             (movie (title '("B" "C" "D")))
|             (movie (title '("C" "D" "E"))))
|(#[DEFFACTS
|   MOVIES ; (#[MOVIE ; id -1 #x19FF2789] #[MOVIE ; id -1 #x19FF2ADD]
|    #[MOVIE ; id -1 #x19FF2E31])
|   #x19FF2EDD])
|LISA-USER> (defun overlap? (list-1 list-2)
|             (if (not (equal list-1 list-2))
|                   (dotimes (index (min (length list-1)
|                                        (length list-2)))
|                     (if (equal (subseq list-1 (- (length list-1) index 1) (length list-1))
|                                (subseq list-2 0 (+ index 1)))
|                       (return-from overlap? t))))
|             nil)
|OVERLAP?
|LISA-USER> (defrule chain ()
|             (?m1 (movie (title ?title1)))
|             (?m2 (movie (title ?title2)))
|             (test (overlap? ?title1 ?title2))
|             =>
|             (format t "~A ~A~%" ?title1 ?title2))
|#[RULE CHAIN]
|LISA-USER> (reset)
|T
|LISA-USER> (run)
|(A B C) (B C D)
|(B C D) (C D E)
|(A B C) (C D E)
|3

Not quite as elegant... but it works. I never managed to get the not equal test working in the rule so I had to place it in the overlap? function. Other than that, I think they're about as equivalent as they can get.

Going from Clips to Lisa

I'm currently experimenting with (and thinking about moving my current after-work projects to) Lisa. It's close enough to Clips to make it very easy to pick up but there are a few things that will take some time to get used to.

CL-USER> (in-package LISA-USER)
#[PACKAGE LISA-USER]
LISA-USER> (deftemplate foo
    (slot name)
    (slot age))
; Evaluation aborted
LISA-USER> (deftemplate foo ()
    (slot name)
    (slot age))
#[STANDARD-CLASS FOO]
LISA-USER> (assert (foo (name "Johan") (age 34)))
#[FOO ; id 1 #x1A015B01]
LISA-USER> (defrule remove-old-people
      ?foo <- (foo (age ?age&:(> ?age 30)))
      =>
      (retract ?foo))
; Evaluation aborted
LISA-USER> (defrule remove-old-people
      (?foo (foo (age ?age (> ?age 30))))
      =>
      (retract ?foo))
; Evaluation aborted
LISA-USER> (defrule remove-old-people ()
      (?foo (foo (age ?age (> ?age 30))))
      =>
      (retract ?foo))
#[RULE REMOVE-OLD-PEOPLE]
LISA-USER> (agenda)
#[ACTIVATION (INITIAL-CONTEXT.RETRACT-PEOPLE-OVER-30 (F-1) ; salience = 0)
#x19FAED25]
#[ACTIVATION (INITIAL-CONTEXT.RETRACT-PEOPLE-OVER-30 (F-1) ; salience = 0)
#x19FAED25]
For a total of 2 activations.
; No value
LISA-USER> (facts)
#[FOO ; id 1 #x19FAEBDD]
For a total of 1 fact.
; No value
LISA-USER> (run)
1
LISA-USER> (facts)
For a total of 0 facts.
; No value
LISA-USER>

Each of the ; Evaluation aborted lines marks where I was sent into the debugger. I'm not sure how I managed to get two activations but I suspect that part of the rule was already created when I got the error of not having specified any keywords. No warning about redefining the rule though!

Anyway, Lisa allows me to use the full power of Common Lisp side by side with a Rete-engine and I must admit I kind of like that idea. Lately, one of the things I've come to miss in Clips is the ability to define rules dynamically. I've tried using eval:

CLIPS> (eval "(defrule blah (whatever) =>)")
[EXPRNPSR3] Missing function declaration for defrule.
FALSE

but without success.

Whenever such a need has appeared I have used Python to dynamically generate the source code which I then load and run in Clips but I'd prefer to keep it all in one place and since I know better than to have delusions about pyRete performance I *think* this might be the way to go.

[2007-10-17] Update: Less than an hour after I posted this I learned that there is indeed a way to generate rules dynamically. The function is called build and is described in chapter 12.3.6 Evaluating a Construct within a String of the Clips Basic Programming Guide. Thanks Gary and Peter for pointing this out.

Another paper to read

Last week, I found Jeremy Wertheimer's master thesis from MIT; Derivation of an efficient rule system pattern matcher. It seems very interesting. He derives a Rete implementation using program transformations (in the programming language Refine which seems to be some Lisp dialect or other). Apparently he starts out with a small formal specification of Rete and applies transformations to it step by step in order to derive an efficient pattern matcher. Very cool.

Working Daze