                           (:file "shared-node")
                           (:file "successor")
                           (:file "node-pair")
-diff -Nurp lisa_ORIGINAL/lisa.patch lisa/lisa.patch
---- lisa_ORIGINAL/lisa.patch	2008-01-23 10:13:01.375000000 -0800
-+++ lisa/lisa.patch	1969-12-31 16:00:00.000000000 -0800
-@@ -1,19 +0,0 @@
--src/rete/reference/rete-compiler.lisp
--===================================================================
--RCS file: /cvsroot/lisa/lisa/src/rete/reference/rete-compiler.lisp,v
--retrieving revision 1.52
--diff -r1.52 rete-compiler.lisp
--212,217c212,217
--< (defun copy-node-test-table (src)
--<   (let ((target (make-hash-table :test #'equal)))
--<     (maphash (lambda (key value)
--<                (setf (gethash key target) value))
--<              src)
--<     target))
-----
--> (defun copy-node-test-table (src) src)
--> ;;;;   (let ((target (make-hash-table :test #'equal)))
--> ;;;;     (maphash (lambda (key value)
--> ;;;;                (setf (gethash key target) value))
--> ;;;;              src)
--> ;;;;     target))
-\ No newline at end of file
-diff -Nurp lisa_ORIGINAL/match-timing.lisp lisa/match-timing.lisp
---- lisa_ORIGINAL/match-timing.lisp	1969-12-31 16:00:00.000000000 -0800
-+++ lisa/match-timing.lisp	2008-02-20 20:30:59.765625000 -0800
-@@ -0,0 +1,26 @@
-+(in-package :lisa-user)
-+
-+(defclass x () ((a :initarg :a)))
-+(defclass y () ((b :initarg :b)))
-+(defrule match () (x (a ?v)) (y (b ?v)) => (format t "+"))
-+(defun test (n)
-+  "Times the matching of n instances"
-+  (reset)
-+  (dotimes (i n)
-+    (assert-instance (make-instance 'x :a i))
-+    (assert-instance (make-instance 'y :b i)))
-+  (run))
-+
-+
-+(defun time-series (from to &optional (step 1))
-+  "Calls TEST with increasing N (from FROM to TO, by STEP), 
-+   and returns a list representing milliseconds taken by each call"
-+  (loop for n from from upto to by step
-+        for time = (get-internal-real-time) 
-+        do (test n)
-+        collect (list n (- (get-internal-real-time) time))))
-+
-+(defvar *time-series* (time-series 1 1001 100))
-+
-+(loop for (n time) in *time-series*
-+      do (format t "~&~S~C~S~%" n #\tab (coerce (/ time 1000) 'float)))
-\ No newline at end of file
-diff -Nurp lisa_ORIGINAL/src/core/#watches.lisp# lisa/src/core/#watches.lisp#
---- lisa_ORIGINAL/src/core/#watches.lisp#	2008-01-22 17:20:40.312500000 -0800
-+++ lisa/src/core/#watches.lisp#	1969-12-31 16:00:00.000000000 -0800
-@@ -1,120 +0,0 @@
--;;; This file is part of LISA, the Lisp-based Intelligent Software
--;;; Agents platform.
--
--;;; Copyright (C) 2000 David E. Young (de.young@computer.org)
--
--;;; This library is free software; you can redistribute it and/or
--;;; modify it under the terms of the GNU Lesser General Public License
--;;; as published by the Free Software Foundation; either version 2.1
--;;; of the License, or (at your option) any later version.
--
--;;; This library is distributed in the hope that it will be useful,
--;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
--;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--;;; GNU Lesser General Public License for more details.
--
--;;; You should have received a copy of the GNU Lesser General Public License
--;;; along with this library; if not, write to the Free Software
--;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
--
--;;; File: watches.lisp
--;;; Description:
--
--;;; $Id: lisa3_2-inter-pattern-filter.patch,v 1.1 2008/03/07 23:47:27 amallavarapu Exp $
--
--(in-package "LISA")
--
--(defvar *assert-fact* nil)
--(defvar *retract-fact* nil)
--(defvar *enable-activation* nil)
--(defvar *disable-activation* nil)
--(defvar *fire-rule* nil)
--(defvar *watches* nil)
--
--(defun watch-activation-detail (activation direction)
--  (format *trace-output* "~A Activation: ~A : ~A~%"
--          direction
--          (rule-default-name (activation-rule activation))
--          (activation-fact-list activation))
--  (finish-output *trace-output*)
--  (values))
--
--(defun watch-enable-activation (activation)
--  (watch-activation-detail activation "==>"))
--
--(defun watch-disable-activation (activation)
--  (watch-activation-detail activation "<=="))
--
--(defun watch-rule-firing (activation)
--  (let ((rule (activation-rule activation)))
--    (format *trace-output* "FIRE ~D: ~A ~A~%"
--            (rete-firing-count (rule-engine rule))
--            (rule-default-name rule)
--            (activation-fact-list activation))
--    (finish-output *trace-output*)
--    (values)))
--
--(defun watch-fact-detail (fact direction)
--  (format *trace-output* "~A ~A ~S~%"
--          direction (fact-symbolic-id fact)
--          (reconstruct-fact fact))
--  (finish-output *trace-output*)
--  (values))
--
--(defun watch-assert (fact)
--  (watch-fact-detail fact "==>"))
--
--(defun watch-retract (fact)
--  (watch-fact-detail fact "<=="))
--
--(defun watch-event (event)
--  (ecase event
--    (:facts (setf *assert-fact* #'watch-assert)
--            (setf *retract-fact* #'watch-retract))
--    (:activations (setf *enable-activation* #'watch-enable-activation)
--                  (setf *disable-activation* #'watch-disable-activation))
--    (:rules (setf *fire-rule* #'watch-rule-firing))
--    (:all (watch-event :facts)
--          (watch-event :activations)
--          (watch-event :rules)))
--  (unless (eq event :all)
--    (pushnew event *watches*))
--  event)
--
--(defun unwatch-event (event)
--  (ecase event
--    (:facts (setf *assert-fact* nil)
--            (setf *retract-fact* nil))
--    (:activations (setf *enable-activation* nil)
--                  (setf *disable-activation* nil))
--    (:rules (setf *fire-rule* nil))
--    (:all (unwatch-event :facts)
--          (unwatch-event :activations)
--          (unwatch-event :rules)))
--  (unless (eq event :all)
--    (setf *watches*
--      (delete event *watches*)))
--  event)
--
--(defun watches ()
--  *watches*)
--
--(defmacro trace-assert (fact)
--  `(unless (null *assert-fact*)
--     (funcall *assert-fact* ,fact)))
--
--(defmacro trace-retract (fact)
--  `(unless (null *retract-fact*)
--     (funcall *retract-fact* ,fact)))
--
--(defmacro trace-enable-activation (activation)
--  `(unless (null *enable-activation*)
--     (funcall *enable-activation* ,activation)))
--
--(defmacro trace-disable-activation (activation)
--  `(unless (null *disable-activation*)
--     (funcall *disable-activation* ,activation)))
--
--(defmacro trace-firing (activation)
--  `(unless (null *fire-rule*)
--     (funcall *fire-rule* ,activation)))
-diff -Nurp lisa_ORIGINAL/src/rete/reference/.#node-tests.lisp.1.24 lisa/src/rete/reference/.#node-tests.lisp.1.24
---- lisa_ORIGINAL/src/rete/reference/.#node-tests.lisp.1.24	1969-12-31 16:00:00.000000000 -0800
-+++ lisa/src/rete/reference/.#node-tests.lisp.1.24	2008-02-19 08:17:23.515625000 -0800
-@@ -0,0 +1,176 @@
-+;;; This file is part of LISA, the Lisp-based Intelligent Software
-+;;; Agents platform.
-+
-+;;; Copyright (C) 2000 David E. Young (de.young@computer.org)
-+
-+;;; This library is free software; you can redistribute it and/or
-+;;; modify it under the terms of the GNU Lesser General Public License
-+;;; as published by the Free Software Foundation; either version 2.1
-+;;; of the License, or (at your option) any later version.
-+
-+;;; This library is distributed in the hope that it will be useful,
-+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-+;;; GNU Lesser General Public License for more details.
-+
-+;;; You should have received a copy of the GNU Lesser General Public License
-+;;; along with this library; if not, write to the Free Software
-+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
-+
-+;;; File: node-tests.lisp
-+;;; Description:
-+
-+;;; $Id: lisa3_2-inter-pattern-filter.patch,v 1.1 2008/03/07 23:47:27 amallavarapu Exp $
-+
-+(in-package "LISA")
-+
-+(defvar *node-test-table*)
-+
-+(defun find-test (key constructor)
-+  (or (gethash key *node-test-table*)
-+      (setf (gethash key *node-test-table*)
-+            (funcall constructor))))
-+  
-+(defun clear-node-test-table ()
-+  (clrhash *node-test-table*))
-+
-+(defmethod class-matches-p ((instance inference-engine-object) fact class)
-+  (eq (fact-name fact) class))
-+  
-+(defmethod class-matches-p ((instance t) fact class)
-+  (or (eq (fact-name fact) class)
-+      (has-superclass fact class)))
-+
-+(defun make-class-test (class)
-+  (find-test class
-+             #'(lambda ()
-+                 (function
-+                  (lambda (token)
-+                    (declare (optimize (speed 3) (debug 1) (safety 0)))
-+                    (let ((fact (token-top-fact token)))
-+                      (class-matches-p 
-+                       (find-instance-of-fact fact) fact class)))))))
-+
-+(defun make-simple-slot-test-aux (slot-name value negated-p)
-+  (find-test 
-+   `(,slot-name ,value ,negated-p)
-+   #'(lambda ()
-+       (let ((test
-+              (function
-+               (lambda (token)
-+                 (declare (optimize (speed 3) (debug 1) (safety 0)))
-+                 (equal value
-+                        (get-slot-value
-+                         (token-top-fact token)
-+                         slot-name))))))
-+         (if negated-p
-+             (complement test)
-+           test)))))
-+
-+(defun make-simple-slot-test (slot)
-+  (declare (type pattern-slot slot))
-+  (make-simple-slot-test-aux
-+   (pattern-slot-name slot)
-+   (pattern-slot-value slot)
-+   (pattern-slot-negated slot)))
-+
-+#+ignore
-+(defmacro make-variable-test (slot-name binding)
-+  `(function
-+    (lambda (tokens)
-+      (equal (get-slot-value (token-top-fact tokens) ,slot-name)
-+             (get-slot-value 
-+              (token-find-fact tokens (binding-address ,binding))
-+              (binding-slot-name ,binding))))))
-+
-+(defun make-inter-pattern-test (slot)
-+  (let* ((binding (pattern-slot-slot-binding slot))
-+         (test
-+          (function
-+           (lambda (tokens)
-+             (declare (optimize (speed 3) (debug 1) (safety 0)))
-+             (equal (get-slot-value (token-top-fact tokens) ; top-token is the right token
-+                                    (pattern-slot-name slot))
-+                    (get-slot-value  ; this is the left-token
-+                     (token-find-fact tokens (binding-address binding))
-+                     (binding-slot-name binding)))))))
-+    (if (negated-slot-p slot) (complement test) test)))
-+
-+
-+(defun make-predicate-test (forms bindings &optional (negated-p nil))
-+  (let* ((special-vars
-+          (mapcar #'binding-variable bindings))
-+         (body
-+          (if (consp (first forms)) 
-+              forms
-+            (list forms)))
-+         (predicate
-+          (compile nil `(lambda ()
-+                          (declare (special ,@special-vars))
-+                          ,@body)))
-+         (test
-+          (function
-+           (lambda (tokens)
-+             (progv
-+                 `(,@special-vars)
-+                 `(,@(mapcar #'(lambda (binding)
-+                                 (if (pattern-binding-p binding)
-+                                     (token-find-fact 
-+                                      tokens (binding-address binding))
-+                                   (get-slot-value
-+                                    (token-find-fact 
-+                                     tokens (binding-address binding))
-+                                    (binding-slot-name binding))))
-+                             bindings))
-+               (funcall predicate))))))
-+    (if negated-p (complement test) test)))
-+
-+(defun make-intra-pattern-predicate (forms bindings negated-p)
-+  (let* ((special-vars
-+          (mapcar #'binding-variable bindings))
-+         (body
-+          (if (consp (first forms)) 
-+              forms
-+            (list forms)))
-+         (predicate
-+          (compile nil `(lambda ()
-+                          (declare (special ,@special-vars))
-+                          (declare (optimize (speed 3) (debug 1) (safety 0)))
-+                          ,@body)))
-+         (test
-+          (function
-+           (lambda (tokens)
-+             (progv
-+                 `(,@special-vars)
-+                 `(,@(mapcar #'(lambda (binding)
-+                                 (declare (optimize (speed 3) (debug 1) (safety 0)))
-+                                 (if (pattern-binding-p binding)
-+                                     (token-find-fact 
-+                                      tokens (binding-address binding))
-+                                   (get-slot-value
-+                                    (token-top-fact tokens)
-+                                    (binding-slot-name binding))))
-+                             bindings))
-+               (funcall predicate))))))
-+    (if negated-p (complement test) test)))
-+         
-+(defun make-intra-pattern-constraint-test (slot)
-+  (make-intra-pattern-predicate
-+   (pattern-slot-constraint slot)
-+   (pattern-slot-constraint-bindings slot)
-+   (negated-slot-p slot)))
-+
-+(defun make-intra-pattern-test (slot)
-+  (let ((test
-+         (function
-+          (lambda (tokens)
-+            (declare (optimize (speed 3) (debug 1) (safety 0)))
-+            (equal (get-slot-value (token-top-fact tokens)
-+                                   (pattern-slot-name slot))
-+                   (get-slot-value (token-top-fact tokens)
-+                                   (binding-slot-name 
-+                                    (pattern-slot-slot-binding slot))))))))
-+    (if (negated-slot-p slot) (complement test) test)))
-+
-+(defun make-behavior (function bindings)
-+  (make-predicate-test function bindings))
-diff -Nurp lisa_ORIGINAL/src/rete/reference/.#node2.lisp.1.21 lisa/src/rete/reference/.#node2.lisp.1.21
---- lisa_ORIGINAL/src/rete/reference/.#node2.lisp.1.21	1969-12-31 16:00:00.000000000 -0800
-+++ lisa/src/rete/reference/.#node2.lisp.1.21	2008-02-14 14:41:58.828125000 -0800
-@@ -0,0 +1,74 @@
-+;;; This file is part of LISA, the Lisp-based Intelligent Software
-+;;; Agents platform.
-+
-+;;; Copyright (C) 2000 David E. Young (de.young@computer.org)
-+
-+;;; This library is free software; you can redistribute it and/or
-+;;; modify it under the terms of the GNU Lesser General Public License
-+;;; as published by the Free Software Foundation; either version 2.1
-+;;; of the License, or (at your option) any later version.
-+
-+;;; This library is distributed in the hope that it will be useful,
-+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-+;;; GNU Lesser General Public License for more details.
-+
-+;;; You should have received a copy of the GNU Lesser General Public License
-+;;; along with this library; if not, write to the Free Software
-+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
-+
-+;;; File: node2.lisp
-+;;; Description:
-+
-+;;; $Id: lisa3_2-inter-pattern-filter.patch,v 1.1 2008/03/07 23:47:27 amallavarapu Exp $
-+
-+(in-package "LISA")
-+
-+(defclass node2 (join-node) 
-+  (left-value-memory :init-form (make-hash-table :test #'equal))
-+  (right-value-memory :init-form (make-hash-table :test #'equal)))
-+
-+;;; old test-against-left/right-memory:
-+
-+(defmethod test-against-right-memory ((self node2) left-tokens)
-+  (loop for right-token being the hash-values of (join-node-right-memory self)
-+      do (when (test-tokens self left-tokens right-token)
-+           (pass-tokens-to-successor 
-+            self (combine-tokens left-tokens right-token)))))
-+
-+(defmethod test-against-left-memory ((self node2) (right-token add-token))
-+   (loop for left-tokens being the hash-values of (join-node-left-memory self)
-+       do (when (test-tokens self left-tokens right-token)
-+            (pass-tokens-to-successor 
-+             self (combine-tokens left-tokens right-token)))))
-+   
-+
-+(defmethod test-against-left-memory ((self node2) (right-token remove-token))
-+   (loop for left-tokens being the hash-values of (join-node-left-memory self)
-+      do (when (test-tokens self left-tokens right-token)
-+            (pass-tokens-to-successor
-+             self (combine-tokens
-+                   (make-remove-token left-tokens) right-token)))))
-+  
-+(defmethod accept-tokens-from-left ((self node2) (left-tokens add-token))
-+  (add-tokens-to-left-memory self left-tokens)
-+  (test-against-right-memory self left-tokens))
-+
-+(defmethod accept-token-from-right ((self node2) (right-token add-token))
-+  (add-token-to-right-memory self right-token)
-+  (test-against-left-memory self right-token))
-+
-+(defmethod accept-tokens-from-left ((self node2) (left-tokens remove-token))
-+  (when (remove-tokens-from-left-memory self left-tokens)
-+    (test-against-right-memory self left-tokens)))
-+
-+(defmethod accept-token-from-right ((self node2) (right-token remove-token))
-+  (when (remove-token-from-right-memory self right-token)
-+    (test-against-left-memory self right-token)))
-+
-+(defvar *join-nodes* ())
-+(defun make-node2 ()
-+  (let ((jnode  (make-instance 'node2)))
-+    (push jnode *join-nodes*)
-+    jnode))
-+
-diff -Nurp lisa_ORIGINAL/src/rete/reference/.#rete-compiler.lisp.1.52 lisa/src/rete/reference/.#rete-compiler.lisp.1.52
---- lisa_ORIGINAL/src/rete/reference/.#rete-compiler.lisp.1.52	1969-12-31 16:00:00.000000000 -0800
-+++ lisa/src/rete/reference/.#rete-compiler.lisp.1.52	2008-01-23 08:48:44.046875000 -0800
-@@ -0,0 +1,240 @@
-+;;; This file is part of LISA, the Lisp-based Intelligent Software
-+;;; Agents platform.
-+
-+;;; Copyright (C) 2000 David E. Young (de.young@computer.org)
-+
-+;;; This library is free software; you can redistribute it and/or
-+;;; modify it under the terms of the GNU Lesser General Public License
-+;;; as published by the Free Software Foundation; either version 2.1
-+;;; of the License, or (at your option) any later version.
-+
-+;;; This library is distributed in the hope that it will be useful,
-+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-+;;; GNU Lesser General Public License for more details.
-+
-+;;; You should have received a copy of the GNU Lesser General Public License
-+;;; along with this library; if not, write to the Free Software
-+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
-+
-+;;; File: rete-compiler.lisp
-+;;; Description:
-+
-+;;; $Id: lisa3_2-inter-pattern-filter.patch,v 1.1 2008/03/07 23:47:27 amallavarapu Exp $
-+
-+(in-package "LISA")
-+
-+(defvar *root-nodes* nil)
-+(defvar *rule-specific-nodes* nil)
-+(defvar *leaf-nodes* nil)
-+(defvar *logical-block-marker*)
-+
-+(declaim (inline set-leaf-node leaf-node left-input right-input logical-block-marker))
-+
-+(defun set-leaf-node (node address)
-+  (setf (aref *leaf-nodes* address) node))
-+
-+(defun leaf-node ()
-+  (aref *leaf-nodes* (1- (length *leaf-nodes*))))
-+
-+(defun left-input (address)
-+  (aref *leaf-nodes* (1- address)))
-+
-+(defun right-input (address)
-+  (aref *leaf-nodes* address))
-+
-+(defun logical-block-marker ()
-+  *logical-block-marker*)
-+  
-+(defclass rete-network ()
-+  ((root-nodes :initform (make-hash-table)
-+               :initarg :root-nodes
-+               :reader rete-roots)
-+   (node-test-cache :initform (make-hash-table :test #'equal)
-+                    :initarg :node-test-cache
-+                    :reader node-test-cache)))
-+
-+(defun record-node (node parent)
-+  (when (typep parent 'shared-node)
-+    (increment-use-count parent))
-+  (push (make-node-pair node parent) *rule-specific-nodes*)
-+  node)
-+
-+(defmethod remove-node-from-parent ((self rete-network) (parent t) child)
-+  (remhash (node1-test child) (rete-roots self)))
-+
-+(defmethod remove-node-from-parent ((self rete-network) 
-+                                    (parent shared-node) child)
-+  (remove-successor parent child))
-+
-+(defun make-root-node (class)
-+  (let* ((test (make-class-test class))
-+         (root (gethash test *root-nodes*)))
-+    (when (null root)
-+      (setf root (make-node1 test))
-+      (setf (gethash test *root-nodes*) root))
-+    (record-node root t)))
-+
-+(defmethod add-successor ((parent t) new-node connector)
-+  (declare (ignore connector))
-+  new-node)
-+
-+(defmethod add-successor :around ((parent shared-node) new-node connector)
-+  (declare (ignore new-node connector))
-+  (record-node (call-next-method) parent))
-+
-+(defun make-intra-pattern-node (slot)
-+  (let ((test
-+         (cond ((simple-slot-p slot)
-+                (make-simple-slot-test slot))
-+               ((constrained-slot-p slot)
-+                (make-intra-pattern-constraint-test slot))
-+               (t
-+                (make-intra-pattern-test slot)))))
-+    (make-node1 test)))
-+
-+(defun distribute-token (rete-network token)
-+  (loop for root-node being the hash-values 
-+      of (rete-roots rete-network)
-+      do (accept-token root-node token)))
-+
-+(defmethod make-rete-network (&rest args &key &allow-other-keys)
-+  (apply #'make-instance 'rete-network args))
-+
-+;;; The following functions serve as "connectors" between any two
-+;;; nodes. PASS-TOKEN connects two pattern (one-input) nodes, or a join node 
-+;;; to a terminal node; ENTER-JOIN-NETWORK-FROM-LEFT connects a pattern node
-+;;; to a join node; ENTER-JOIN-NETWORK-FROM-RIGHT also connects a pattern node
-+;;; to a join node; both PASS-TOKENS-ON-LEFT and PASS-TOKEN-ON-RIGHT connect
-+;;; two join nodes.
-+
-+(defun pass-token (node token)
-+  (accept-token node token))
-+
-+(defun pass-tokens-on-left (node2 tokens)
-+  (accept-tokens-from-left node2 tokens))
-+
-+(defun pass-token-on-right (node2 token)
-+  (accept-token-from-right node2 token))
-+
-+(defun enter-join-network-from-left (node2 tokens)
-+  (pass-tokens-on-left node2 (replicate-token tokens)))
-+
-+(defun enter-join-network-from-right (node2 token)
-+  (pass-token-on-right node2 (replicate-token token)))
-+
-+;;; end connector functions
-+
-+(defun add-intra-pattern-nodes (patterns)
-+  "The alpha memory nodes and tests"
-+  (dolist (pattern patterns)
-+    (cond ((test-pattern-p pattern)
-+           (set-leaf-node t (parsed-pattern-address pattern)))
-+          (t
-+           (let ((node
-+                  (make-root-node (parsed-pattern-class pattern)))
-+                 (address (parsed-pattern-address pattern)))
-+             (set-leaf-node node address)
-+             (dolist (slot (parsed-pattern-slots pattern))
-+               (when (intra-pattern-slot-p slot)
-+                 (setf node
-+                   (add-successor node (make-intra-pattern-node slot)
-+                                  #'pass-token))
-+                 (set-leaf-node node address))))))))
-+
-+(defun add-join-node-tests (join-node pattern)
-+  (labels ((add-simple-join-node-test (slot)
-+             (unless (= (binding-address (pattern-slot-slot-binding slot))
-+                        (parsed-pattern-address pattern))
-+               (join-node-add-test join-node
-+                                   (make-inter-pattern-test slot))))
-+           (add-slot-constraint-test (slot)
-+             (join-node-add-test join-node
-+                                 (make-predicate-test
-+                                  (pattern-slot-constraint slot)
-+                                  (pattern-slot-constraint-bindings slot)
-+                                  (negated-slot-p slot))))
-+           (add-test-pattern-predicate ()
-+             (join-node-add-test join-node
-+                                 (make-predicate-test
-+                                  (parsed-pattern-test-forms pattern)
-+                                  (parsed-pattern-test-bindings pattern))))
-+           (add-generic-pattern-tests ()
-+             (dolist (slot (parsed-pattern-slots pattern))
-+               (cond ((simple-bound-slot-p slot)
-+                      (add-simple-join-node-test slot))
-+                     ((constrained-slot-p slot)
-+                      (add-slot-constraint-test slot))))))
-+    (if (test-pattern-p pattern)
-+        (add-test-pattern-predicate)
-+      (add-generic-pattern-tests))
-+    join-node))
-+
-+(defun make-join-node (pattern)
-+  (let ((join-node
-+         (cond ((negated-pattern-p pattern)
-+                (make-node2-not))
-+               ((test-pattern-p pattern)
-+                (make-node2-test))
-+               ((existential-pattern-p pattern)
-+                (make-node2-exists))
-+               (t (make-node2)))))
-+    (when (eql (parsed-pattern-address pattern) (logical-block-marker))
-+      (mark-as-logical-block join-node (logical-block-marker)))
-+    join-node))
-+
-+(defun make-left-join-connection (join-node node)
-+  (if (typep node 'shared-node)
-+      (add-successor node join-node #'enter-join-network-from-left)
-+    (add-successor node join-node #'pass-tokens-on-left))
-+  join-node)
-+
-+(defun make-right-join-connection (join-node node)
-+  (if (typep node 'shared-node)
-+      (add-successor node join-node #'enter-join-network-from-right)
-+    (add-successor node join-node #'pass-token-on-right))
-+  join-node)
-+
-+(defun add-inter-pattern-nodes (patterns)
-+  "The beta memory nodes and tests"
-+  (dolist (pattern (rest patterns))
-+    (let ((join-node (make-join-node pattern))
-+          (address (parsed-pattern-address pattern)))
-+      (add-join-node-tests join-node pattern)
-+      (make-left-join-connection join-node (left-input address))
-+      (make-right-join-connection join-node (right-input address))
-+      (set-leaf-node join-node address))))
-+
-+(defun add-terminal-node (rule)
-+  (add-successor (leaf-node) (make-terminal-node rule) #'pass-token))
-+
-+;;; addresses a problem reported by Andrew Philpot on 9/6/2007
-+(defun copy-node-test-table (src) src)
-+;;;;   (let ((target (make-hash-table :test #'equal)))
-+;;;;     (maphash (lambda (key value)
-+;;;;                (setf (gethash key target) value))
-+;;;;              src)
-+;;;;     target))
-+
-+(defun compile-rule-into-network (rete-network patterns rule)
-+  (let ((*root-nodes* (rete-roots rete-network))
-+        (*rule-specific-nodes* (list))
-+        (*leaf-nodes* (make-array (length patterns)))
-+        (*logical-block-marker* (rule-logical-marker rule))
-+        (*node-test-table* (node-test-cache rete-network)))
-+    (add-intra-pattern-nodes patterns)
-+    (add-inter-pattern-nodes patterns)
-+    (add-terminal-node rule)
-+    (attach-rule-nodes rule (nreverse *rule-specific-nodes*))
-+    (setf (slot-value rete-network 'root-nodes) *root-nodes*)
-+    rete-network))
-+
-+(defun merge-rule-into-network (to-network patterns rule &key (loader nil))
-+  (let ((from-network
-+         (compile-rule-into-network
-+          (make-rete-network :node-test-cache (copy-node-test-table (node-test-cache to-network)))
-+          patterns rule)))
-+    (when loader
-+      (funcall loader from-network))
-+    (attach-rule-nodes rule (merge-networks from-network to-network))
-+    to-network))
-diff -Nurp lisa_ORIGINAL/src/rete/reference/CVS/Entries lisa/src/rete/reference/CVS/Entries
---- lisa_ORIGINAL/src/rete/reference/CVS/Entries	2008-02-20 12:48:13.312500000 -0800
-+++ lisa/src/rete/reference/CVS/Entries	2008-02-20 22:45:00.156250000 -0800
-@@ -4,13 +4,14 @@
- /node-pair.lisp/1.1/Thu Oct  3 14:48:08 2002//
- /node1.lisp/1.16/Tue Sep 11 21:14:10 2007//
- /node2-exists.lisp/1.3/Tue Sep 11 21:14:10 2007//
--/node2-not.lisp/1.15/Tue Sep 11 21:14:10 2007//
- /node2-test.lisp/1.6/Tue Sep 11 21:14:10 2007//
- /shared-node.lisp/1.12/Tue Sep 11 21:14:10 2007//
- /successor.lisp/1.4/Mon Oct  7 19:55:13 2002//
- /terminal-node.lisp/1.12/Mon Sep 13 19:27:53 2004//
- /tms.lisp/1.1/Thu Nov 14 14:45:38 2002//
--/node-tests.lisp/1.24/Wed Feb 20 20:48:12 2008//
--/node2.lisp/1.21/Wed Feb 20 20:48:13 2008//
--/rete-compiler.lisp/1.52/Wed Feb 20 20:48:13 2008//
-+/rete-compiler.lisp/1.52/Mon Jan 28 23:58:26 2008//
-+/node2.lisp/1.21/Thu Feb 14 22:47:09 2008//
-+/node2-not.lisp/1.15/Tue Feb 19 15:45:40 2008//
-+/node-tests.lisp/1.24/Thu Feb 21 04:20:21 2008//
-+/inter-pattern-filter.lisp/0/New file//
- D
-diff -Nurp lisa_ORIGINAL/src/rete/reference/CVS/Entries.Extra lisa/src/rete/reference/CVS/Entries.Extra
---- lisa_ORIGINAL/src/rete/reference/CVS/Entries.Extra	2008-02-20 12:48:13.312500000 -0800
-+++ lisa/src/rete/reference/CVS/Entries.Extra	2008-02-20 20:20:21.312500000 -0800
-@@ -4,12 +4,12 @@
- /node-pair.lisp////*///
- /node1.lisp////*///
- /node2-exists.lisp////*///
--/node2-not.lisp////*///
- /node2-test.lisp////*///
- /shared-node.lisp////*///
- /successor.lisp////*///
- /terminal-node.lisp////*///
- /tms.lisp////*///
--/node-tests.lisp////*///
--/node2.lisp////*///
- /rete-compiler.lisp////*///
-+/node2.lisp////*///
-+/node2-not.lisp////*///
-+/node-tests.lisp////*///
-diff -Nurp lisa_ORIGINAL/src/rete/reference/CVS/Entries.Extra.Old lisa/src/rete/reference/CVS/Entries.Extra.Old
---- lisa_ORIGINAL/src/rete/reference/CVS/Entries.Extra.Old	2008-01-28 15:58:26.265625000 -0800
-+++ lisa/src/rete/reference/CVS/Entries.Extra.Old	2008-02-20 20:19:18.234375000 -0800
-@@ -4,12 +4,12 @@
- /node-pair.lisp////*///
- /node1.lisp////*///
- /node2-exists.lisp////*///
--/node2-not.lisp////*///
- /node2-test.lisp////*///
--/node2.lisp////*///
- /shared-node.lisp////*///
- /successor.lisp////*///
- /terminal-node.lisp////*///
- /tms.lisp////*///
- /node-tests.lisp////*///
- /rete-compiler.lisp////*///
-+/node2.lisp////*///
-+/node2-not.lisp////*///
-diff -Nurp lisa_ORIGINAL/src/rete/reference/CVS/Entries.Old lisa/src/rete/reference/CVS/Entries.Old
---- lisa_ORIGINAL/src/rete/reference/CVS/Entries.Old	2008-01-28 15:58:26.250000000 -0800
-+++ lisa/src/rete/reference/CVS/Entries.Old	2008-02-20 20:19:18.234375000 -0800
-@@ -4,13 +4,13 @@
- /node-pair.lisp/1.1/Thu Oct  3 14:48:08 2002//
- /node1.lisp/1.16/Tue Sep 11 21:14:10 2007//
- /node2-exists.lisp/1.3/Tue Sep 11 21:14:10 2007//
--/node2-not.lisp/1.15/Tue Sep 11 21:14:10 2007//
- /node2-test.lisp/1.6/Tue Sep 11 21:14:10 2007//
--/node2.lisp/1.21/Tue Sep 11 21:14:10 2007//
- /shared-node.lisp/1.12/Tue Sep 11 21:14:10 2007//
- /successor.lisp/1.4/Mon Oct  7 19:55:13 2002//
- /terminal-node.lisp/1.12/Mon Sep 13 19:27:53 2004//
- /tms.lisp/1.1/Thu Nov 14 14:45:38 2002//
- /node-tests.lisp/1.24/Wed Jan 23 16:39:10 2008//
- /rete-compiler.lisp/1.52/Mon Jan 28 23:58:26 2008//
-+/node2.lisp/1.21/Thu Feb 14 22:47:09 2008//
-+/node2-not.lisp/1.15/Tue Feb 19 15:45:40 2008//
- D
-diff -Nurp lisa_ORIGINAL/src/rete/reference/inter-pattern-filter.lisp lisa/src/rete/reference/inter-pattern-filter.lisp
---- lisa_ORIGINAL/src/rete/reference/inter-pattern-filter.lisp	1969-12-31 16:00:00.000000000 -0800
-+++ lisa/src/rete/reference/inter-pattern-filter.lisp	2008-02-20 16:16:15.921875000 -0800
+Index: src/rete/reference/inter-pattern-filter.lisp
+===================================================================
+RCS file: src/rete/reference/inter-pattern-filter.lisp
+diff -N src/rete/reference/inter-pattern-filter.lisp
+--- /dev/null	1 Jan 1970 00:00:00 -0000
++++ src/rete/reference/inter-pattern-filter.lisp	6 Jun 2008 16:25:18 -0000
 @@ -0,0 +1,195 @@
 +
 +;;; Copyright (C) 2008 Aneil Mallavarapu

+
+(defmethod add-slot-filter ((self join-node) slot)
+  (join-node-add-test self (make-inter-pattern-test slot)))
diff -Nurp lisa_ORIGINAL/src/rete/reference/join-node.lisp~ lisa/src/rete/reference/join-node.lisp~
--- lisa_ORIGINAL/src/rete/reference/join-node.lisp~	1969-12-31 16:00:00.000000000 -0800
+++ lisa/src/rete/reference/join-node.lisp~	2008-02-19 08:28:47.328125000 -0800
@@ -0,0 +1,112 @@
+;;; This file is part of LISA, the Lisp-based Intelligent Software
+;;; Agents platform.
+
+;;; Copyright (C) 2000 David E. Young (de.young@computer.org)
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+;;; File: join-node.lisp
+;;; Description:
+
+;;; $Id: lisa3_2-inter-pattern-filter.patch,v 1.1 2008/03/07 23:47:27 amallavarapu Exp $
+
+(in-package "LISA")
+
+(defclass join-node ()
+  ((successor :initform nil
+              :accessor join-node-successor)
+   (logical-block :initform nil
+                  :reader join-node-logical-block)
+   (tests :initform (list)
+          :accessor join-node-tests)
+   (left-memory :initform (make-hash-table :test #'equal)
+                :reader join-node-left-memory)
+   (right-memory :initform (make-hash-table :test #'equal)
+                 :reader join-node-right-memory)))
+
+(defun mark-as-logical-block (join-node marker)
+  (setf (slot-value join-node 'logical-block) marker))
+
+(defun logical-block-p (join-node)
+  (numberp (join-node-logical-block join-node)))
+
+(defun remember-token (memory token)
+  (setf (gethash (hash-key token) memory) token))
+
+(defun forget-token (memory token)
+  (remhash (hash-key token) memory))
+
+(defun add-tokens-to-left-memory (join-node tokens)
+  (remember-token (join-node-left-memory join-node) tokens))
+
+(defun add-token-to-right-memory (join-node token)
+  (remember-token (join-node-right-memory join-node) token))
+
+(defun remove-tokens-from-left-memory (join-node tokens)
+  (forget-token (join-node-left-memory join-node) tokens))
+
+(defun remove-token-from-right-memory (join-node token)
+  (forget-token (join-node-right-memory join-node) token))
+
+(defmethod left-memory-count ((self join-node))
+  (hash-table-count (join-node-left-memory self)))
+
+(defmethod right-memory-count ((self join-node))
+  (hash-table-count (join-node-right-memory self)))
+
+(defmethod test-tokens ((self join-node) left-tokens right-token)
+  (token-push-fact left-tokens (token-top-fact right-token))
+  (prog1
+      (every #'(lambda (test)
+                 (funcall test left-tokens))
+             (join-node-tests self))
+    (token-pop-fact left-tokens)))
+
+(defmethod pass-tokens-to-successor ((self join-node) left-tokens)
+  (call-successor (join-node-successor self) left-tokens))
+
+(defmethod combine-tokens ((left-tokens token) (right-token token))
+  (token-push-fact (replicate-token left-tokens) (token-top-fact right-token)))
+
+(defmethod combine-tokens ((left-tokens token) (right-token t))
+  (token-push-fact (replicate-token left-tokens) right-token))
+
+(defmethod add-successor ((self join-node) successor-node connector)
+  (setf (join-node-successor self)
+    (make-successor successor-node connector)))
+
+(defmethod join-node-add-test ((self join-node) test)
+  (push test (join-node-tests self)))
+
+(defmethod clear-memories ((self join-node))
+  (clrhash (join-node-left-memory self))
+  (clrhash (join-node-right-memory self)))
+
+(defmethod accept-tokens-from-left ((self join-node) (left-tokens reset-token))
+  (clear-memories self)
+  (pass-tokens-to-successor self left-tokens))
+
+(defmethod accept-token-from-right ((self join-node) (left-tokens reset-token))
+  nil)
+
+(defmethod print-object ((self join-node) strm)
+  (print-unreadable-object (self strm :type t :identity t)
+    (format strm "left ~S ; right ~S ; tests ~S"
+            (left-memory-count self)
+            (right-memory-count self)
+            (length (join-node-tests self)))))
+
+(defmethod add-slot-filter ((self join-node) slot)
+  (join-node-add-test self (make-inter-pattern-test slot)))
diff -Nurp lisa_ORIGINAL/src/rete/reference/node-tests.lisp~ lisa/src/rete/reference/node-tests.lisp~
--- lisa_ORIGINAL/src/rete/reference/node-tests.lisp~	1969-12-31 16:00:00.000000000 -0800
+++ lisa/src/rete/reference/node-tests.lisp~	2008-02-17 07:23:04.421875000 -0800
@@ -0,0 +1,182 @@
+;;; This file is part of LISA, the Lisp-based Intelligent Software
+;;; Agents platform.
+
+;;; Copyright (C) 2000 David E. Young (de.young@computer.org)
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+;;; File: node-tests.lisp
+;;; Description:
+
+;;; $Id: lisa3_2-inter-pattern-filter.patch,v 1.1 2008/03/07 23:47:27 amallavarapu Exp $
+
+(in-package "LISA")
+
+(defvar *node-test-table*)
+
+(defun find-test (key constructor)
+  (or (gethash key *node-test-table*)
+      (setf (gethash key *node-test-table*)
+            (funcall constructor))))
+  
+(defun clear-node-test-table ()
+  (clrhash *node-test-table*))
+
+(defmethod class-matches-p ((instance inference-engine-object) fact class)
+  (eq (fact-name fact) class))
+  
+(defmethod class-matches-p ((instance t) fact class)
+  (or (eq (fact-name fact) class)
+      (has-superclass fact class)))
+
+(defun make-class-test (class)
+  (find-test class
+             #'(lambda ()
+                 (function
+                  (lambda (token)
+                    (declare (optimize (speed 3) (debug 1) (safety 0)))
+                    (let ((fact (token-top-fact token)))
+                      (class-matches-p 
+                       (find-instance-of-fact fact) fact class)))))))
+
+(defun make-simple-slot-test-aux (slot-name value negated-p)
+  (find-test 
+   `(,slot-name ,value ,negated-p)
+   #'(lambda ()
+       (let ((test
+              (function
+               (lambda (token)
+                 (declare (optimize (speed 3) (debug 1) (safety 0)))
+                 (equal value
+                        (get-slot-value
+                         (token-top-fact token)
+                         slot-name))))))
+         (if negated-p
+             (complement test)
+           test)))))
+
+(defun make-simple-slot-test (slot)
+  (declare (type pattern-slot slot))
+  (make-simple-slot-test-aux
+   (pattern-slot-name slot)
+   (pattern-slot-value slot)
+   (pattern-slot-negated slot)))
+
+#+ignore
+(defmacro make-variable-test (slot-name binding)
+  `(function
+    (lambda (tokens)
+      (equal (get-slot-value (token-top-fact tokens) ,slot-name)
+             (get-slot-value 
+              (token-find-fact tokens (binding-address ,binding))
+              (binding-slot-name ,binding))))))
+
+;;;; (defun make-inter-pattern-test (slot)
+;;;;   (let* ((binding (pattern-slot-slot-binding slot))
+;;;;          (test
+;;;;           (function
+;;;;            (lambda (tokens)
+;;;;              (declare (optimize (speed 3) (debug 1) (safety 0)))
+;;;;              (equal (get-slot-value (token-top-fact tokens) ; top-token is the right token
+;;;;                                     (pattern-slot-name slot))
+;;;;                     (get-slot-value  ; this is the left-token
+;;;;                      (token-find-fact tokens (binding-address binding))
+;;;;                      (binding-slot-name binding)))))))
+;;;;     (if (negated-slot-p slot) (complement test) test)))
+
+(defun make-inter-pattern-test (slot) 
+  (let ((binding (pattern-slot-slot-binding slot)))
+    (%make-inter-pattern-test :slot-name (pattern-slot-name slot)
+                              :binding-slot-name (binding-slot-name binding)
+                              :binding-address (binding-address binding)
+                              :negated (pattern-slot-negated slot))))
+
+(defun make-predicate-test (forms bindings &optional (negated-p nil))
+  (let* ((special-vars
+          (mapcar #'binding-variable bindings))
+         (body
+          (if (consp (first forms)) 
+              forms
+            (list forms)))
+         (predicate
+          (compile nil `(lambda ()
+                          (declare (special ,@special-vars))
+                          ,@body)))
+         (test
+          (function
+           (lambda (tokens)
+             (progv
+                 `(,@special-vars)
+                 `(,@(mapcar #'(lambda (binding)
+                                 (if (pattern-binding-p binding)
+                                     (token-find-fact 
+                                      tokens (binding-address binding))
+                                   (get-slot-value
+                                    (token-find-fact 
+                                     tokens (binding-address binding))
+                                    (binding-slot-name binding))))
+                             bindings))
+               (funcall predicate))))))
+    (if negated-p (complement test) test)))
+
+(defun make-intra-pattern-predicate (forms bindings negated-p)
+  (let* ((special-vars
+          (mapcar #'binding-variable bindings))
+         (body
+          (if (consp (first forms)) 
+              forms
+            (list forms)))
+         (predicate
+          (compile nil `(lambda ()
+                          (declare (special ,@special-vars))
+                          (declare (optimize (speed 3) (debug 1) (safety 0)))
+                          ,@body)))
+         (test
+          (function
+           (lambda (tokens)
+             (progv
+                 `(,@special-vars)
+                 `(,@(mapcar #'(lambda (binding)
+                                 (declare (optimize (speed 3) (debug 1) (safety 0)))
+                                 (if (pattern-binding-p binding)
+                                     (token-find-fact 
+                                      tokens (binding-address binding))
+                                   (get-slot-value
+                                    (token-top-fact tokens)
+                                    (binding-slot-name binding))))
+                             bindings))
+               (funcall predicate))))))
+    (if negated-p (complement test) test)))
+         
+(defun make-intra-pattern-constraint-test (slot)
+  (make-intra-pattern-predicate
+   (pattern-slot-constraint slot)
+   (pattern-slot-constraint-bindings slot)
+   (negated-slot-p slot)))
+
+(defun make-intra-pattern-test (slot)
+  (let ((test
+         (function
+          (lambda (tokens)
+            (declare (optimize (speed 3) (debug 1) (safety 0)))
+            (equal (get-slot-value (token-top-fact tokens)
+                                   (pattern-slot-name slot))
+                   (get-slot-value (token-top-fact tokens)
+                                   (binding-slot-name 
+                                    (pattern-slot-slot-binding slot))))))))
+    (if (negated-slot-p slot) (complement test) test)))
+
+(defun make-behavior (function bindings)
+  (make-predicate-test function bindings))
diff -Nurp lisa_ORIGINAL/src/rete/reference/node2-not.lisp~ lisa/src/rete/reference/node2-not.lisp~
--- lisa_ORIGINAL/src/rete/reference/node2-not.lisp~	1969-12-31 16:00:00.000000000 -0800
+++ lisa/src/rete/reference/node2-not.lisp~	2007-09-11 14:14:10.000000000 -0700
@@ -0,0 +1,71 @@
+;;; This file is part of LISA, the Lisp-based Intelligent Software
+;;; Agents platform.
+
+;;; Copyright (C) 2000 David E. Young (de.young@computer.org)
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+;;; File: node2-not.lisp
+;;; Description:
+
+;;; $Id: lisa3_2-inter-pattern-filter.patch,v 1.1 2008/03/07 23:47:27 amallavarapu Exp $
+
+(in-package "LISA")
+
+(defclass node2-not (join-node) ())
+
+(defmethod test-against-right-memory ((self node2-not) left-tokens)
+  (loop for right-token being the hash-values of (join-node-right-memory self)
+      do (when (test-tokens self left-tokens right-token)
+           (token-increment-not-counter left-tokens)))
+  (unless (token-negated-p left-tokens)
+    (pass-tokens-to-successor 
+     self (combine-tokens left-tokens self))))
+
+(defmethod test-against-left-memory ((self node2-not) 
+                                     (right-token add-token))
+  (loop for left-tokens being the hash-values of (join-node-left-memory self)
+      do (when (test-tokens self left-tokens right-token)
+           (token-increment-not-counter left-tokens)
+           (pass-tokens-to-successor 
+            self (combine-tokens (make-remove-token left-tokens) self)))))
+  
+(defmethod test-against-left-memory ((self node2-not) 
+                                     (right-token remove-token))
+  (loop for left-tokens being the hash-values of (join-node-left-memory self)
+      do (when (and (test-tokens self left-tokens right-token)
+                    (not (token-negated-p
+                          (token-decrement-not-counter left-tokens))))
+           (pass-tokens-to-successor 
+            self (combine-tokens left-tokens self)))))
+  
+(defmethod accept-tokens-from-left ((self node2-not) (left-tokens add-token))
+  (add-tokens-to-left-memory self left-tokens)
+  (test-against-right-memory self left-tokens))
+
+(defmethod accept-tokens-from-left ((self node2-not) (left-tokens remove-token))
+  (when (remove-tokens-from-left-memory self left-tokens)
+    (pass-tokens-to-successor self (combine-tokens left-tokens self))))
+
+(defmethod accept-token-from-right ((self node2-not) (right-token add-token))
+  (add-token-to-right-memory self right-token)
+  (test-against-left-memory self right-token))
+
+(defmethod accept-token-from-right ((self node2-not) (right-token remove-token))
+  (when (remove-token-from-right-memory self right-token)
+    (test-against-left-memory self right-token)))
+
+(defun make-node2-not ()
+  (make-instance 'node2-not))
diff -Nurp lisa_ORIGINAL/src/rete/reference/node2.lisp lisa/src/rete/reference/node2.lisp
--- lisa_ORIGINAL/src/rete/reference/node2.lisp	2008-02-20 12:48:13.015625000 -0800
+++ lisa/src/rete/reference/node2.lisp	2008-02-20 16:16:15.906250000 -0800
@@ -24,43 +24,105 @@
 
 (in-package "LISA")

Index: lisa.asd
===================================================================
RCS file: /cvsroot/lisa/lisa/lisa.asd,v
retrieving revision 1.7
diff -u -r1.7 lisa.asd
--- lisa.asd	11 Sep 2007 21:14:07 -0000	1.7
+++ lisa.asd	6 Jun 2008 16:25:14 -0000
@@ -100,7 +100,8 @@
                (:module rete
                         :pathname "rete/reference/"
