@@ -47,8 +47,8 @@

       (undo-record r))))

-; *max-record-index* holds the maximum legal index for record-array

-; so it and the following must be changed at the same time

+;; *max-record-index* holds the maximum legal index for record-array

+;; so it and the following must be changed at the same time

 (defun begin-record (p data)

   (setq *recording* t)

@@ -57,7 +57,7 @@

 (defun end-record ()

   (when *recording*

     (setq *record*

-	  (cons *cycle-count* (cons *p-name* *record*)))

+          (cons *cycle-count* (cons *p-name* *record*)))

     (record-index-plus 1.)

     (setf (aref *record-array* *record-index*) *record*)

     (setq *record* nil)

@@ -66,13 +66,13 @@

 (defun record-change (direct time elm)

   (when *recording*

     (setq *record*

-	  (cons direct (cons time (cons elm *record*)))))) 

+          (cons direct (cons time (cons elm *record*)))))) 

-; to maintain refraction information, need keep only one piece of information:

-; need to record all unsuccessful attempts to delete things from the conflict

-; set.  unsuccessful deletes are caused by attempting to delete refracted

-; instantiations.  when backing up, have to avoid putting things back into the

-; conflict set if they were not deleted when running forward

+;; to maintain refraction information, need keep only one piece of information:

+;; need to record all unsuccessful attempts to delete things from the conflict

+;; set.  unsuccessful deletes are caused by attempting to delete refracted

+;; instantiations.  when backing up, have to avoid putting things back into the

+;; conflict set if they were not deleted when running forward

 (defun record-refract (rule data)

   (when *recording*

@@ -82,25 +82,25 @@

   (when *refracts*

     (let ((z (cons rule data)))

       (member z *refracts* :test #'equal)))

-  #|(prog (z)

-    (and (null *refracts*) (return nil))

-    (setq z (cons rule data))

-    (return (member z *refracts* :test #'equal)))|#

-  )

+  #+(or)

+  (prog (z)

+     (and (null *refracts*) (return nil))

+     (setq z (cons rule data))

+     (return (member z *refracts* :test #'equal))))

 (defun record-index-plus (k)

   (incf *record-index* k)

   (cond ((< *record-index* 0.)

-	 (setq *record-index* *max-record-index*))

-	((> *record-index* *max-record-index*)

-	 (setq *record-index* 0.)))) 

+         (setq *record-index* *max-record-index*))

+        ((> *record-index* *max-record-index*)

+         (setq *record-index* 0.))))

-; the following routine initializes the record.  putting nil in the

-; first slot indicates that that the record does not go back further

-; than that.  (when the system backs up, it writes nil over the used

-; records so that it will recognize which records it has used.  thus

-; the system is set up anyway never to back over a nil.)

+;; the following routine initializes the record.  putting nil in the

+;; first slot indicates that that the record does not go back further

+;; than that.  (when the system backs up, it writes nil over the used

+;; records so that it will recognize which records it has used.  thus

+;; the system is set up anyway never to back over a nil.)

 (defun initialize-record nil

   (setq *record-index* 0.)

@@ -111,82 +111,81 @@

 ;; replaced per jcp

 ;;; Commented out

-#|

+#+(or)

 (defun undo-record (r)

   (prog (save act a b rate)

-    ;###	(comment *recording* must be off during back up)

-    (setq save *recording*)

-    (setq *refracts* nil)

-    (setq *recording* nil)

-    (and *ptrace* (back-print (list '|undo:| (car r) (cadr r))))

-    (setq r (cddr r))

-    top  (and (atom r) (go fin))

-    (setq act (car r))

-    (setq a (cadr r))

-    (setq b (caddr r))

-    (setq r (cdddr r))

-    (and *wtrace* (back-print (list '|undo:| act a)))

-    (cond ((eq act '<=wm) (add-to-wm b a))

-	  ((eq act '=>wm) (remove-from-wm b))

-	  ((eq act '<=refract)

-	   (setq *refracts* (cons (cons a b) *refracts*)))

-	  ((and (eq act '=>refract) (still-present b))

-	   (setq *refracts* (delete (cons a b) *refracts*))

-	   (setq rate (rating-part (gethash a *topnode-table*)))

-	   (removecs a b)

-	   (insertcs a b rate))

-	  (t (%warn '|back: cannot undo action| (list act a))))

-    (go top)

-    fin  (setq *recording* save)

-    (setq *refracts* nil)

-    (return nil)))

+     ;;###	(comment *recording* must be off during back up) ;

+     (setq save *recording*)

+     (setq *refracts* nil)

+     (setq *recording* nil)

+     (and *ptrace* (back-print (list '|undo:| (car r) (cadr r))))

+     (setq r (cddr r))

+   top  (and (atom r) (go fin))

+     (setq act (car r))

+     (setq a (cadr r))

+     (setq b (caddr r))

+     (setq r (cdddr r))

+     (and *wtrace* (back-print (list '|undo:| act a)))

+     (cond ((eq act '<=wm) (add-to-wm b a))

+           ((eq act '=>wm) (remove-from-wm b))

+           ((eq act '<=refract)

+            (setq *refracts* (cons (cons a b) *refracts*)))

+           ((and (eq act '=>refract) (still-present b))

+            (setq *refracts* (delete (cons a b) *refracts*))

+            (setq rate (rating-part (gethash a *topnode-table*)))

+            (removecs a b)

+            (insertcs a b rate))

+           (t (%warn '|back: cannot undo action| (list act a))))

+     (go top)

+   fin  (setq *recording* save)

+     (setq *refracts* nil)

+     (return nil)))

 ;;; End commented out

-|#

 (defun undo-record (r)

   (prog (save act a b rate)

-    ;###	(comment *recording* must be off during back up)

-    (setq save *recording*)

-    (setq *refracts* nil)

-    (setq *recording* nil)

-    (and *ptrace* (back-print (list '|undo:| (car r) (cadr r))))

-    (setq r (cddr r))

-    top  (and (atom r) (go fin))

-    (setq act (car r))

-    (setq a (cadr r))

-    (setq b (caddr r))

-    (setq r (cdddr r))

-    (and *wtrace* (back-print (list '|undo:| act a)))

-    (cond ((eq act '<=wm) (add-to-wm b a))

-	  ((eq act '=>wm) (remove-from-wm b))

-	  ((eq act '<=refract)

-	   (setq *refracts* (cons (cons a b) *refracts*)))

-	  ((and (eq act '=>refract) (still-present b))

-	   (setq *refracts* (tree-remove (cons a b) *refracts*))

-	   (setq rate (rating-part (gethash a *topnode-table*)))

-	   (removecs a b)

-	   (insertcs a b rate))

-	  (t (%warn '|back: cannot undo action| (list act a))))

-    (go top)

-    fin  (setq *recording* save)

-    (setq *refracts* nil)

-    (return nil))) 

-

-

-

-; still-present makes sure that the user has not deleted something

-; from wm which occurs in the instantiation about to be restored; it

-; makes the check by determining whether each wme still has a time tag.

+     ;;###	(comment *recording* must be off during back up)

+     (setq save *recording*)

+     (setq *refracts* nil)

+     (setq *recording* nil)

+     (and *ptrace* (back-print (list '|undo:| (car r) (cadr r))))

+     (setq r (cddr r))

+   top  (and (atom r) (go fin))

+     (setq act (car r))

+     (setq a (cadr r))

+     (setq b (caddr r))

+     (setq r (cdddr r))

+     (and *wtrace* (back-print (list '|undo:| act a)))

+     (cond ((eq act '<=wm) (add-to-wm b a))

+           ((eq act '=>wm) (remove-from-wm b))

+           ((eq act '<=refract)

+            (setq *refracts* (cons (cons a b) *refracts*)))

+           ((and (eq act '=>refract) (still-present b))

+            (setq *refracts* (tree-remove (cons a b) *refracts*))

+            (setq rate (rating-part (gethash a *topnode-table*)))

+            (removecs a b)

+            (insertcs a b rate))

+           (t (%warn '|back: cannot undo action| (list act a))))

+     (go top)

+   fin  (setq *recording* save)

+     (setq *refracts* nil)

+     (return nil))) 

+

+

+

+;; still-present makes sure that the user has not deleted something

+;; from wm which occurs in the instantiation about to be restored; it

+;; makes the check by determining whether each wme still has a time tag.

 (defun still-present (data)

   (prog nil

-    loop

-    (cond ((atom data) (return t))

-	  ((creation-time (car data))

-	   (setq data (cdr data))

-	   (go loop))

-	  (t (return nil))))) 

+   loop

+     (cond ((atom data) (return t))

+           ((creation-time (car data))

+            (setq data (cdr data))

+            (go loop))

+           (t (return nil))))) 

 (defun back-print (x) 

   (let ((stream (trace-file)))

@@ -17,8 +17,8 @@

 ;;;; This file contains functions compile productions.

 (in-package "OPS")

-;(shadow '(remove write))    ; Should get this by requiring ops-rhs

-;(export '--> )

+;;(shadow '(remove write))    ; Should get this by requiring ops-rhs

+;;(export '--> )

 ;;; External global variables

@@ -58,7 +58,7 @@

 (defun ops-p (z) 

   (finish-literalize)

   (princ '*) 

-  ;(drain) commented out temporarily

+  ;;(drain) commented out temporarily

   (force-output)			;@@@ clisp drain?

   (compile-production (car z) (cdr z))) 

@@ -68,13 +68,14 @@

   (setq *p-name* name)

   (catch '!error! (cmp-p name matrix))

   (setq *p-name* nil))

-#|

+

+#+(or)

 (defun compile-production (name matrix) ;jgk inverted args to catch 

   (prog (erm)				;and quoted tag

-    (setq *p-name* name)

-    (setq erm (catch '!error! (cmp-p name matrix)))

-    (setq *p-name* nil)))

-|#

+     (setq *p-name* name)

+     (setq erm (catch '!error! (cmp-p name matrix)))

+     (setq *p-name* nil)))

+

 (defun peek-lex ()

   (car *matrix*)) 

@@ -105,37 +106,37 @@

 (defun cmp-p (name matrix)

   (prog (m bakptrs)

-    (cond ((or (null name) (consp  name))	;dtpr\consp gdw

-	   (%error '|illegal production name| name))

-	  ((equal (gethash name *production-table*) matrix)

-	   (return nil)))

-    (prepare-lex matrix)

-    (excise-p name)

-    (setq bakptrs nil)

-    (incf *pcount*)		;"plus" changed to "+" by gdw

-    (setq *feature-count* 0.)

-    (setq *ce-count* 0)

-    (setq *vars* nil)

-    (setq *ce-vars* nil)

-    (setq *rhs-bound-vars* nil)

-    (setq *rhs-bound-ce-vars* nil)

-    (setq *last-branch* nil)

-    (setq m (rest-of-p))

-    l1   (and (end-of-p) (%error '|no '-->' in production| m))

-    (cmp-prin)

-    (setq bakptrs (cons *last-branch* bakptrs))

-    (or (eq '--> (peek-lex)) (go l1))

-    (lex)

-    (check-rhs (rest-of-p))

-    (link-new-node (list '&p

-			 *feature-count*

-			 name

-			 (encode-dope)

-			 (encode-ce-dope)

-			 (cons 'progn (rest-of-p))))

-    (setf (gethash name *backpointers-table*) (cdr (nreverse bakptrs)))

-    (setf (gethash name *production-table*) matrix)

-    (setf (gethash name *topnode-table*) *last-node*))) 

+     (cond ((or (null name) (consp  name))	;dtpr\consp gdw

+            (%error '|illegal production name| name))

+           ((equal (gethash name *production-table*) matrix)

+            (return nil)))

+     (prepare-lex matrix)

+     (excise-p name)

+     (setq bakptrs nil)

+     (incf *pcount*)		;"plus" changed to "+" by gdw

+     (setq *feature-count* 0.)

+     (setq *ce-count* 0)

+     (setq *vars* nil)

+     (setq *ce-vars* nil)

+     (setq *rhs-bound-vars* nil)

+     (setq *rhs-bound-ce-vars* nil)

+     (setq *last-branch* nil)

+     (setq m (rest-of-p))

+   l1   (and (end-of-p) (%error '|no '-->' in production| m))

+     (cmp-prin)

+     (setq bakptrs (cons *last-branch* bakptrs))

+     (or (eq '--> (peek-lex)) (go l1))

+     (lex)

+     (check-rhs (rest-of-p))

+     (link-new-node (list '&p

+                          *feature-count*

+                          name

+                          (encode-dope)

+                          (encode-ce-dope)

+                          (cons 'progn (rest-of-p))))

+     (setf (gethash name *backpointers-table*) (cdr (nreverse bakptrs)))

+     (setf (gethash name *production-table*) matrix)

+     (setf (gethash name *topnode-table*) *last-node*))) 

 (defun rating-part (pnode) (cadr pnode)) 

@@ -148,23 +149,23 @@

 (defun cmp-prin nil

   (setq *last-node* *first-node*)

   (cond ((null *last-branch*) (cmp-posce) (cmp-nobeta))

-	((eq (peek-lex) '-) (cmp-negce) (cmp-not))

-	(t (cmp-posce) (cmp-and)))) 

+        ((eq (peek-lex) '-) (cmp-negce) (cmp-not))

+        (t (cmp-posce) (cmp-and)))) 

 (defun cmp-negce nil (lex) (cmp-ce)) 

 (defun cmp-posce nil

   (setq *ce-count* (1+ *ce-count*))		;"plus" changed to "+" by gdw

   (cond ((eq (peek-lex) '\{) (cmp-ce+cevar))	;"plus" changed to "+" by gdw

-	(t (cmp-ce)))) 

+        (t (cmp-ce)))) 

 (defun cmp-ce+cevar ()

   (prog (z)

-    (lex)

-    (cond ((atom (peek-lex)) (cmp-cevar) (cmp-ce))

-	  (t (cmp-ce) (cmp-cevar)))

-    (setq z (lex))

-    (or (eq z '\}) (%error '|missing '}'| z)))) 

+     (lex)

+     (cond ((atom (peek-lex)) (cmp-cevar) (cmp-ce))

+           (t (cmp-ce) (cmp-cevar)))

+     (setq z (lex))

+     (or (eq z '\}) (%error '|missing '}'| z)))) 

 (defun new-subnum (k)

   (or (numberp k) (%error '|tab must be a number| k))

@@ -175,42 +176,42 @@

 (defun cmp-ce ()

   (prog (z)

-    (new-subnum 0.)

-    (setq *cur-vars* nil)

-    (setq z (lex))

-    (and (atom z)

-	 (%error '|atomic conditions are not allowed| z))

-    (prepare-sublex z)

-    la   (and (end-of-ce) (return nil))

-    (incr-subnum)

-    (cmp-element)

-    (go la))) 

+     (new-subnum 0.)

+     (setq *cur-vars* nil)

+     (setq z (lex))

+     (and (atom z)

+          (%error '|atomic conditions are not allowed| z))

+     (prepare-sublex z)

+   la   (and (end-of-ce) (return nil))

+     (incr-subnum)

+     (cmp-element)

+     (go la))) 

 (defun cmp-element nil

   (when (eq (peek-sublex) '^)

     (cmp-tab))

   (cond ((eq (peek-sublex) '\{) (cmp-product))

-	(t (cmp-atomic-or-any))))

+        (t (cmp-atomic-or-any))))

 (defun cmp-atomic-or-any ()

   (cond ((eq (peek-sublex) '<<) (cmp-any))

-	(t (cmp-atomic))))

+        (t (cmp-atomic))))

 (defun cmp-any ()

   (prog (a z)

-    (sublex)

-    (setq z nil)

-    la   (cond ((end-of-ce) (%error '|missing '>>'| a)))

-    (setq a (sublex))

-    (cond ((not (eq '>> a)) (setq z (cons a z)) (go la)))

-    (link-new-node (list '&any nil (current-field) z)))) 

+     (sublex)

+     (setq z nil)

+   la   (cond ((end-of-ce) (%error '|missing '>>'| a)))

+     (setq a (sublex))

+     (cond ((not (eq '>> a)) (setq z (cons a z)) (go la)))

+     (link-new-node (list '&any nil (current-field) z)))) 

 (defun cmp-tab nil

   (prog (r)

-    (sublex)

-    (setq r (sublex))

-    (setq r ($litbind r))

-    (new-subnum r))) 

+     (sublex)

+     (setq r (sublex))

+     (setq r ($litbind r))

+     (new-subnum r))) 

 (defun get-bind (x)

   (when (symbolp x)

@@ -218,28 +219,28 @@

 (defun cmp-atomic nil

   (prog (test x)

-    (setq x (peek-sublex))

-    (cond ((eq x '= ) (setq test 'eq) (sublex))

-	  ((eq x '<>) (setq test 'ne) (sublex))

-	  ((eq x '<) (setq test 'lt) (sublex))

-	  ((eq x '<=) (setq test 'le) (sublex))

-	  ((eq x '>) (setq test 'gt) (sublex))

-	  ((eq x '>=) (setq test 'ge) (sublex))

-	  ((eq x '<=>) (setq test 'xx) (sublex))

-	  (t (setq test 'eq)))

-    (cmp-symbol test))) 

+     (setq x (peek-sublex))

+     (cond ((eq x '= ) (setq test 'eq) (sublex))

+           ((eq x '<>) (setq test 'ne) (sublex))

+           ((eq x '<) (setq test 'lt) (sublex))

+           ((eq x '<=) (setq test 'le) (sublex))

+           ((eq x '>) (setq test 'gt) (sublex))

+           ((eq x '>=) (setq test 'ge) (sublex))

+           ((eq x '<=>) (setq test 'xx) (sublex))

+           (t (setq test 'eq)))

+     (cmp-symbol test))) 

 (defun cmp-product ()

   (prog (save)

-    (setq save (rest-of-ce))

-    (sublex)

-    la   (cond ((end-of-ce)

-		(cond ((member '\} save :test #'equal) 

-		       (%error '|wrong contex for '}'| save))

-		      (t (%error '|missing '}'| save))))

-	       ((eq (peek-sublex) '\}) (sublex) (return nil)))

-    (cmp-atomic-or-any)

-    (go la))) 

+     (setq save (rest-of-ce))

+     (sublex)

+   la   (cond ((end-of-ce)

+               (cond ((member '\} save :test #'equal) 

+                      (%error '|wrong contex for '}'| save))

+                     (t (%error '|missing '}'| save))))

+              ((eq (peek-sublex) '\}) (sublex) (return nil)))

+     (cmp-atomic-or-any)

+     (go la))) 

 (defun cmp-symbol (test)

   (let ((flag t))

@@ -247,77 +248,77 @@

       (sublex)

       (setq flag nil))

     (cond ((and flag (variablep (peek-sublex)))

-	   (cmp-var test))

-	  ((numberp (peek-sublex)) (cmp-number test))

-	  ((symbolp (peek-sublex)) (cmp-constant test))

-	  (t (%error '|unrecognized symbol| (sublex)))))) 

+           (cmp-var test))

+          ((numberp (peek-sublex)) (cmp-number test))

+          ((symbolp (peek-sublex)) (cmp-constant test))

+          (t (%error '|unrecognized symbol| (sublex)))))) 

 (defun cmp-constant (test)   ;jgk inserted concatenate form

   (or (member test '(eq ne xx))

       (%error '|non-numeric constant after numeric predicate| (sublex)))

   (link-new-node (list (intern (concatenate 'string

-					    "T"

-					    (symbol-name  test)

-					    "A"))

-		       nil

-		       (current-field)

-		       (sublex)))) 

+                                            "T"

+                                            (symbol-name  test)

+                                            "A"))

+                       nil

+                       (current-field)

+                       (sublex)))) 

 (defun cmp-number (test)		;jgk inserted concatenate form

   (link-new-node (list (intern (concatenate 'string

-					    "T"

-					    (symbol-name  test)

-;@@@ error? reported by laird fix\	    "A"

-					    "N"))

-		       nil

-		       (current-field)

-		       (sublex)))) 

+                                            "T"

+                                            (symbol-name  test)

+                                            ;;@@@ error? reported by laird fix\	    "A"

+                                            "N"))

+                       nil

+                       (current-field)

+                       (sublex)))) 

 (defun current-field () (field-name *subnum*)) 

 (defun field-name (num)

   (if (< 0 num 127)

       (svref '#(nil *c1* *c2* *c3* *c4* *c5* *c6* *c7* *c8* *c9* *c10* *c11*

-		    *c12* *c13* *c14* *c15* *c16* *c17* *c18* *c19* *c20* *c21*

-		    *c22* *c23* *c24* *c25* *c26* *c27* *c28* *c29* *c30* *c31*

-		    *c32* *c33* *c34* *c35* *c36* *c37* *c38* *c39* *c40* *c41*

-		    *c42* *c43* *c44* *c45* *c46* *c47* *c48* *c49* *c50* *c51*

-		    *c52* *c53* *c54* *c55* *c56* *c57* *c58* *c59* *c60* *c61*

-		    *c62* *c63* *c64* *c65* *c66* *c67* *c68* *c69* *c70* *c71*

-		    *c72* *c73* *c74* *c75* *c76* *c77* *c78* *c79* *c80* *c81*

-		    *c82* *c83* *c84* *c85* *c86* *c87* *c88* *c89* *c90* *c91*

-		    *c92* *c93* *c94* *c95* *c96* *c97* *c98* *c99* *c100*

-		    *c101* *c102* *c103* *c104* *c105* *c106* *c107* *c108*

-		    *c109* *c110* *c111* *c112* *c113* *c114* *c115* *c116*

-		    *c117* *c118* *c119* *c120* *c121* *c122* *c123* *c124*

-		    *c125* *c126* *c127*)

-	     num)

+                *c12* *c13* *c14* *c15* *c16* *c17* *c18* *c19* *c20* *c21*

+                *c22* *c23* *c24* *c25* *c26* *c27* *c28* *c29* *c30* *c31*

+                *c32* *c33* *c34* *c35* *c36* *c37* *c38* *c39* *c40* *c41*

+                *c42* *c43* *c44* *c45* *c46* *c47* *c48* *c49* *c50* *c51*

+                *c52* *c53* *c54* *c55* *c56* *c57* *c58* *c59* *c60* *c61*

+                *c62* *c63* *c64* *c65* *c66* *c67* *c68* *c69* *c70* *c71*

+                *c72* *c73* *c74* *c75* *c76* *c77* *c78* *c79* *c80* *c81*

+                *c82* *c83* *c84* *c85* *c86* *c87* *c88* *c89* *c90* *c91*

+                *c92* *c93* *c94* *c95* *c96* *c97* *c98* *c99* *c100*

+                *c101* *c102* *c103* *c104* *c105* *c106* *c107* *c108*

+                *c109* *c110* *c111* *c112* *c113* *c114* *c115* *c116*

+                *c117* *c118* *c119* *c120* *c121* *c122* *c123* *c124*

+                *c125* *c126* *c127*)

+             num)

       (%error '|condition is too long| (rest-of-ce))))

 ;;; Compiling variables

-;

-;

-;

-; *cur-vars* are the variables in the condition element currently 

-; being compiled.  *vars* are the variables in the earlier condition

-; elements.  *ce-vars* are the condition element variables.  note

-; that the interpreter will not confuse condition element and regular

-; variables even if they have the same name.

-;

-; *cur-vars* is a list of triples: (name predicate subelement-number)

-; eg:		( (<x> eq 3)

-;		  (<y> ne 1)

-;		  . . . )

-;

-; *vars* is a list of triples: (name ce-number subelement-number)

-; eg:		( (<x> 3 3)

-;		  (<y> 1 1)

-;		  . . . )

-;

-; *ce-vars* is a list of pairs: (name ce-number)

-; eg:		( (ce1 1)

-;		  (<c3> 3)

-;		  . . . )

+;;

+;;

+;;

+;; *cur-vars* are the variables in the condition element currently 

+;; being compiled.  *vars* are the variables in the earlier condition

+;; elements.  *ce-vars* are the condition element variables.  note

+;; that the interpreter will not confuse condition element and regular

+;; variables even if they have the same name.

+;;

+;; *cur-vars* is a list of triples: (name predicate subelement-number)

+;; eg:		( (<x> eq 3)

+;;		  (<y> ne 1)

+;;		  . . . )

+;;

+;; *vars* is a list of triples: (name ce-number subelement-number)

+;; eg:		( (<x> 3 3)

+;;		  (<y> 1 1)

+;;		  . . . )

+;;

+;; *ce-vars* is a list of pairs: (name ce-number)

+;; eg:		( (ce1 1)

+;;		  (<c3> 3)

+;;		  . . . )

 ;;; used only in this file.

 (defmacro var-dope (var) `(assoc ,var *vars*))

@@ -326,47 +327,47 @@

 (defun cmp-var (test)

   (let* ((name (sublex))

-	 (old (assoc name *cur-vars*)))

+         (old (assoc name *cur-vars*)))

     (cond ((and old (eq (cadr old) 'eq))

-	   (cmp-old-eq-var test old))

-	  ((and old (eq test 'eq)) (cmp-new-eq-var name old))

-	  (t (cmp-new-var name test))))) 

+           (cmp-old-eq-var test old))

+          ((and old (eq test 'eq)) (cmp-new-eq-var name old))

+          (t (cmp-new-var name test))))) 

 (defun cmp-new-var (name test)

   (push (list name test *subnum*) 

-	*cur-vars*)) 

+        *cur-vars*)) 

 (defun cmp-old-eq-var (test old)	; jgk inserted concatenate form

   (link-new-node (list (intern (concatenate 'string

-					    "T"

-					    (symbol-name  test)

-					    "S"))

-		       nil

-		       (current-field)

-		       (field-name (caddr old))))) 

+                                            "T"

+                                            (symbol-name  test)

+                                            "S"))

+                       nil

+                       (current-field)

+                       (field-name (caddr old))))) 

 (defun cmp-new-eq-var (name old)	;jgk inserted concatenate form

   (prog (pred next)

-    (setq *cur-vars* (delete old *cur-vars* :test #'eq))

-    (setq next (assoc name *cur-vars*))

-    (cond (next (cmp-new-eq-var name next))

-	  (t (cmp-new-var name 'eq)))

-    (setq pred (cadr old))

-    (link-new-node (list (intern (concatenate 'string

-					      "T"

-					      (symbol-name  pred)

-					      "S"))

-			 nil

-			 (field-name (caddr old))

-			 (current-field))))) 

+     (setq *cur-vars* (delete old *cur-vars* :test #'eq))

+     (setq next (assoc name *cur-vars*))

+     (cond (next (cmp-new-eq-var name next))

+           (t (cmp-new-var name 'eq)))

+     (setq pred (cadr old))

+     (link-new-node (list (intern (concatenate 'string

+                                               "T"

+                                               (symbol-name  pred)

+                                               "S"))

+                          nil

+                          (field-name (caddr old))

+                          (current-field))))) 

 (defun cmp-cevar nil

   (let* ((name (lex))

-	 (old (assoc name *ce-vars*)))

+         (old (assoc name *ce-vars*)))

     (when old

       (%error '|condition element variable used twice| name))

     (push (list name 0.) 

-	  *ce-vars*))) 

+          *ce-vars*))) 

 (defun cmp-not nil (cmp-beta '&not)) 

@@ -376,49 +377,49 @@

 (defun cmp-beta (kind)

   (prog (tlist vdope vname #|vpred vpos|# old)

-    (setq tlist nil)

-    la   (and (atom *cur-vars*) (go lb))

-    (setq vdope (car *cur-vars*))

-    (setq *cur-vars* (cdr *cur-vars*))

-    (setq vname (car vdope))

-    ;;  (setq vpred (cadr vdope))    Dario - commented out (unused)

-    ;;  (setq vpos (caddr vdope))

-    (setq old (assoc vname *vars*))

-    (cond (old (setq tlist (add-test tlist vdope old)))

-	  ((not (eq kind '&not)) (promote-var vdope)))

-    (go la)

-    lb   (and kind (build-beta kind tlist))

-    (or (eq kind '&not) (fudge))

-    (setq *last-branch* *last-node*))) 

+     (setq tlist nil)

+   la   (and (atom *cur-vars*) (go lb))

+     (setq vdope (car *cur-vars*))

+     (setq *cur-vars* (cdr *cur-vars*))

+     (setq vname (car vdope))

+     ;;  (setq vpred (cadr vdope))    Dario - commented out (unused)

+     ;;  (setq vpos (caddr vdope))

+     (setq old (assoc vname *vars*))

+     (cond (old (setq tlist (add-test tlist vdope old)))

+           ((not (eq kind '&not)) (promote-var vdope)))

+     (go la)

+   lb   (and kind (build-beta kind tlist))

+     (or (eq kind '&not) (fudge))

+     (setq *last-branch* *last-node*))) 

 (defun add-test (list new old) ; jgk inserted concatenate form

   (prog (ttype lloc rloc)

-    (incf *feature-count*)

-    (setq ttype (intern (concatenate 'string "T"

-				     (symbol-name (cadr new))

-				     "B")))

-    (setq rloc (encode-singleton (caddr new)))

-    (setq lloc (encode-pair (cadr old) (caddr old)))

-    (return (cons ttype (cons lloc (cons rloc list)))))) 

+     (incf *feature-count*)

+     (setq ttype (intern (concatenate 'string "T"

+                                      (symbol-name (cadr new))

+                                      "B")))

+     (setq rloc (encode-singleton (caddr new)))

+     (setq lloc (encode-pair (cadr old) (caddr old)))

+     (return (cons ttype (cons lloc (cons rloc list)))))) 

-; the following two functions encode indices so that gelm can

-; decode them as fast as possible

+;; the following two functions encode indices so that gelm can

+;; decode them as fast as possible

 (defun encode-pair (a b) (+ (* 10000. (1- a)) (1- b))) 

-;"plus" changed to "+" by gdw

+;;"plus" changed to "+" by gdw

 (defun encode-singleton (a) (1- a)) 

 (defun promote-var (dope)

   (prog (vname vpred vpos new)

-    (setq vname (car dope))

-    (setq vpred (cadr dope))

-    (setq vpos (caddr dope))

-    (or (eq 'eq vpred)

-	(%error '|illegal predicate for first occurrence|

-		(list vname vpred)))

-    (setq new (list vname 0. vpos))

-    (setq *vars* (cons new *vars*)))) 

+     (setq vname (car dope))

+     (setq vpred (cadr dope))

+     (setq vpos (caddr dope))

+     (or (eq 'eq vpred)

+         (%error '|illegal predicate for first occurrence|

+                 (list vname vpred)))

+     (setq new (list vname 0. vpos))

+     (setq *vars* (cons new *vars*)))) 

 (defun fudge nil

   (mapc #'fudge* *vars*)

@@ -430,15 +431,15 @@

 (defun build-beta (type tests)

   (prog (rpred lpred lnode lef)

-    (link-new-node (list '&mem nil nil (protomem)))

-    (setq rpred *last-node*)

-    (cond ((eq type '&and)

-	   (setq lnode (list '&mem nil nil (protomem))))

-	  (t (setq lnode (list '&two nil nil))))

-    (setq lpred (link-to-branch lnode))

-    (cond ((eq type '&and) (setq lef lpred))

-	  (t (setq lef (protomem))))

-    (link-new-beta-node (list type nil lef rpred tests)))) 

+     (link-new-node (list '&mem nil nil (protomem)))

+     (setq rpred *last-node*)

+     (cond ((eq type '&and)

+            (setq lnode (list '&mem nil nil (protomem))))

+           (t (setq lnode (list '&two nil nil))))

+     (setq lpred (link-to-branch lnode))

+     (cond ((eq type '&and) (setq lef lpred))

+           (t (setq lef (protomem))))

+     (link-new-beta-node (list type nil lef rpred tests)))) 

 (defun protomem nil (list nil)) 

@@ -446,25 +447,25 @@

 (defun encode-dope nil

   (prog (r all z k)

-    (setq r nil)

-    (setq all *vars*)

-    la   (and (atom all) (return r))

-    (setq z (car all))

-    (setq all (cdr all))

-    (setq k (encode-pair (cadr z) (caddr z)))

-    (setq r (cons (car z) (cons k r)))

-    (go la))) 

+     (setq r nil)

+     (setq all *vars*)

+   la   (and (atom all) (return r))

+     (setq z (car all))

+     (setq all (cdr all))

+     (setq k (encode-pair (cadr z) (caddr z)))

+     (setq r (cons (car z) (cons k r)))

+     (go la))) 

 (defun encode-ce-dope nil

   (prog (r all z k)

-    (setq r nil)

-    (setq all *ce-vars*)

-    la   (and (atom all) (return r))

-    (setq z (car all))

-    (setq all (cdr all))

-    (setq k (cadr z))

-    (setq r (cons (car z) (cons k r)))

-    (go la))) 

+     (setq r nil)

+     (setq all *ce-vars*)

+   la   (and (atom all) (return r))

+     (setq z (car all))

+     (setq all (cdr all))

+     (setq k (cadr z))

+     (setq r (cons (car z) (cons k r)))

+     (go la))) 

@@ -472,7 +473,7 @@

 (defun link-new-node (r)

   (cond ((not (member (car r) '(&p &mem &two &and &not) :test #'equal))

-	 (setq *feature-count* (1+ *feature-count*))))

+         (setq *feature-count* (1+ *feature-count*))))

   (setq *virtual-cnt* (1+ *virtual-cnt*))

   (setq *last-node* (link-left *last-node* r))) 

@@ -487,22 +488,22 @@

 (defun link-left (pred succ)

   (prog (a r)

-    (setq a (left-outs pred))

-    (setq r (find-equiv-node succ a))

-    (and r (return r))

-    (setq *real-cnt* (1+ *real-cnt*))

-    (attach-left pred succ)

-    (return succ))) 

+     (setq a (left-outs pred))

+     (setq r (find-equiv-node succ a))

+     (and r (return r))

+     (setq *real-cnt* (1+ *real-cnt*))

+     (attach-left pred succ)

+     (return succ))) 

 (defun link-both (left right succ)

   (prog (a r)

-    (setq a (intersection (left-outs left) (right-outs right)))

-    (setq r (find-equiv-beta-node succ a))

-    (and r (return r))

-    (setq *real-cnt* (1+ *real-cnt*))

-    (attach-left left succ)

-    (attach-right right succ)

-    (return succ))) 

+     (setq a (intersection (left-outs left) (right-outs right)))

+     (setq r (find-equiv-beta-node succ a))

+     (and r (return r))

+     (setq *real-cnt* (1+ *real-cnt*))

+     (attach-left left succ)

+     (attach-right right succ)

+     (return succ))) 

 (defun attach-right (old new)

   (rplaca (cddr old) (cons new (caddr old)))) 

@@ -516,28 +517,28 @@

 (defun find-equiv-node (node list)

   (prog (a)

-    (setq a list)

-    l1   (cond ((atom a) (return nil))

-	       ((equiv node (car a)) (return (car a))))